home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / comm / ca29_3.zip / BBS.SRC < prev    next >
Text File  |  1992-07-03  |  76KB  |  2,424 lines
  1. ; ----- COM-AND Scripted BBS mode
  2. ;    Commenced: 03/18/88 R.McG
  3. ;    Updated:    2/--/89 R.McG
  4. ;           10/--/89 R.McG (Allow blank lines, preserve lines to disc)
  5. ;    Ver 1.1:   11/--/90 R.McG (Make BBSETUP utility script)
  6. ;    Ver 1.2:   11/--/91 R.McG (Correct 88 char record len in BBS-MAIL)
  7. ;            4/--/91 R.McG (Add editor to BBMAINT scripts)
  8. ; -----------------------------------------------------------------------
  9. ;    Goals:
  10. ;    o    Must autodetect caller's baud rate
  11. ;    o    Must work correctly for modems reporting true CD and otherwise.
  12. ;
  13. ;    Functions:
  14. ;    o    ID/Passworded log-on (with registration)
  15. ;    o    Capabilities set by SYSOP
  16. ;    o    UP and DOWNLOADS
  17. ;    o    Mail and bulletins
  18. ;    o    Privileged access (Pathlist,CHDIR, DOS commands)
  19. ; -----------------------------------------------------------------------
  20. ;    Usages:
  21. ;      S0 ------> General scratch buffer
  22. ;      S1 ------> ID;password during logon; ID after logon upper cased
  23. ;      S2-S5 ---> scratch
  24. ;      S6 ------> Logon time (used by Read_Comm to timeout)
  25. ;      S7 ------> scratch
  26. ;      S8 ------> Scratch buffer
  27. ;      S9 ------> General read buffer
  28. ;      S10-S18 -> Scratch buffers
  29. ;      S19 -----> Is used to save default subdir within commands
  30. ;      S20-S25 -> Default values from BBSDAT
  31. ;             S20 -> port, speed
  32. ;             S21 -> modem init we'll use for restart
  33. ;             S22 -> BBS default subdir
  34. ;             S23 -> BBS default files subdir
  35. ;             S24 -> BBS default mail subdir
  36. ;             S25 -> BBS default bulletin subdir
  37. ;      S28 -----> DLDIR on entry
  38. ;      S29 -----> subdirectory on entry
  39. ;
  40. ;      N0 ------> # minutes allowed for call (set by logon)
  41. ;      N10-N19 -> Generally scratch
  42. ;      N97-N99 -> Generally scratch
  43. ;
  44. ;      FLAG(0) -> ON if an error condition is being reported...
  45. ;          Upon return from Read_Comm: ON -> timeout or disconn
  46. ;          Upon return from Logon -> OFF -> Logon OK
  47. ;      FLAG(1) -> After Logon, privileged access if ON
  48. ;      FLAG(2) -> a CHDIR has been performed by a privileged user
  49. ;      FLAG(3) -> There is a logged on caller (if true)
  50. ; -----------------------------------------------------------------------
  51. ;
  52.     LEGEND "Scripted BBS (1.2); initializing"
  53.     WOPEN 10,1  12,78 (default)
  54.     ATSAY 11,3 (default) "Initializing BBS.. "
  55. ;
  56. ;    Set default values (in case BBSDAT does not exist)
  57. ;
  58.     S20 = "_PARM"(11:14)*","*"_PARM"(0:3) ; Port(4),speed(4)
  59.     S21 = "ATE0Q0V1X1S0=2 S7=30 S9=10^M"  ; Standard MINIT for BBS
  60.     S22 = "\BBS"                    ; Set to our subdirectory
  61.     S23 = "\BBS\FILES"              ; Set subdir for files
  62.     S24 = "\BBS\MAIL"               ; Set subdir for mail
  63.     S25 = "\BBS\BULLETIN"           ; Set subdir for bulletins
  64. ;
  65. ;    Initialize COM related values (This is done here to allow BBSDAT
  66. ;    ... edits to override these settings)
  67. ;
  68.     SET PARITY NONE         ; BBS is fixed no parity
  69.     SET DATA 8            ; BBS is fixed 8 data bits
  70.     SET STOP 1            ; bbs is fixed 1 stop bit
  71.     SET MASK ON            ; accept 7 or 8 bits
  72.     SET CR_IN CR_LF         ; Display received c/rs as a cr/lf
  73.     SET ASCII UP_LF LF        ; Send LFs
  74.     SET SOFTFLOW ON         ; Allow XON/XOFF
  75.     SET ZMODEM AUTO OFF        ; Automatic ZMODEM (user must say 'z')
  76.     SET ZMODEM RECOVER OFF        ; No ZMODEM recovery
  77. ;
  78. ;    Replace above values from BBSDAT, if that script exists
  79. ;
  80.     IF ISSC "BBSDAT"
  81.        FCALL "BBSDAT"
  82.     ELSE
  83.        S10 = "_SCRIPT"              ; Get current script fname
  84.        GOSUB Parse_Fname        ; Extract drive:Subdir from name
  85.        S10 = S10*"\BBSDAT"          ; Make new name
  86.        IF ISSC S10 FCALL S10    ; Invoke it if its THERE
  87.        ENDIF
  88. ;
  89. ;    Initialize variables that must be constant
  90. ;
  91.     SUBDIR S29            ; Read current subdir
  92.     DLDIR S28            ; Read current download subdir
  93.  
  94.     FFIRST S22            ; Test for presence of main subd
  95.     IF FAILURE or NOT ISFILE S22*"\BBS-User" ; Test presence of user file
  96.        WCLOSE            ; Clear 'initializing' window
  97.        GOTO NoUser            ; .. Skip if not found
  98.        ENDIF
  99. ;
  100. ;    Initialize other values
  101. ;
  102.     SET BAUD S20(5:8)        ; Starting speed
  103.     SET PORT S20(0:3)        ; Starting port
  104.     SET INAFTER OFF         ; Turn off init after hangup
  105. ;
  106. ;    Initialize other values
  107. ;
  108.     SET ALARM OFF            ; Turn off alarm
  109.     SET ATIME 1            ; Set alarm time to 1 second
  110.     CHDIR S22            ; Set to our subdirectory
  111.     SET DLDIR S23            ; Set DLDIR
  112.     LEGEND "Scripted BBS (1.1);  Press ESC to terminate or to CHAT."
  113.     TRANSMIT "_MESCAPE"             ; Initialize modem (modem escape)
  114.     WCLOSE                ; End init (before ON ESC)
  115.  
  116.     ON ESCAPE GOSUB Escape        ; Enter chat mode on operator escape
  117.     S9 = "* BBS script loaded"      ; Set text of msg
  118.     CLOG S9             ; .. to call log
  119.     GOSUB Log_Item            ; .. and to BBS-Log
  120.     GOTO Restart            ; Branch around subroutines
  121. ; -----------------------------------------------------------------------
  122. ;    Subroutine: Parse drive:subdirectory from file name
  123. ;
  124. ;    S10 passes fully name        S10 returns drive:subdirectory
  125. ;                    S11 returns file name
  126. ;    N10,N11 are scratch values
  127. ; -----------------------------------------------------------------------
  128. ;
  129. Parse_Fname:
  130.     LENGTH S10 N10            ; Find length of string
  131.     FOR N11 = (N10-1),0,-1        ; Scan backwards through string
  132.         IF STRCMP S10(N11:N11) ":" or STRCMP S10(N11:N11) "\" GOTO PAFN100
  133.         ENDFOR
  134.     S11 = S10            ; No drive or path
  135.     S10 = ""                        ; Return null drive:path spec
  136.     RETURN
  137. ;
  138. ;    Extract drive and path from name; N11 points to ":" or "\"
  139. ;
  140. PAFN100:
  141.     S11 = S10(N11+1:N10)        ; Extract name portion
  142.     IF STRCMP S10(N11:N11) "\" DEC N11
  143.     S10 = S10(0:N11)        ; Save ":", remove last "\"
  144.     RETURN
  145. ; -----------------------------------------------------------------------
  146. ;    Subroutine: No user ID file
  147. ;
  148. ;    S0 is used as scratch
  149. ; -----------------------------------------------------------------------
  150. ;
  151. NoUser:
  152. ;
  153. ;    Issue a pop-up
  154. ;
  155.     LEGEND "Scripted BBS (1.1);  Error initializing"
  156.     WOPEN 10,10,17,70 (default) NoUser_End
  157.     ATSAY 10,12 (default) " BBS initialization "
  158.     ATSAY 11,12 (default) "There is no user ID file (BBS-User) to be found on the"
  159.     ATSAY 12,12 (default) "subdirectory: "*S22
  160.     ATSAY 14,12 (default) "The script BBSETUP must be used to identify the subdir-"
  161.     ATSAY 15,12 (default) "ectory used by this BBS, and to create and maintain the"
  162.     ATSAY 16,12 (default) "files it uses."
  163.     ATSAY 17,29 (default) " Press any key to continue "
  164.     KEYGET S0
  165. NoUser_End:
  166.     WCLOSE                ; Close window we opened
  167.     EXIT                ; Finish - no changes need be reset
  168. ;
  169. ; -----------------------------------------------------------------------
  170. ;    Subroutine: Operator ESCAPE
  171. ; -----------------------------------------------------------------------
  172. ;
  173. Escape:
  174.     CURSOR N98,N97
  175.     WOPEN     10,1  20,78 (default) ESC_ESC
  176.     ATSAY     10,3  (default) " BBS Operator menu "
  177.     ATSAY     12,3  (default) "1) Terminate the BBS"
  178.     IF FLAG(3)                ; Not during call
  179.        ATSAY 13,3  (default) "2) Enter chat with caller"
  180.     ELSE
  181.        ATSAY 13,3  (default) ".. No caller currently on "
  182.        ENDIF
  183.     ATSAY     14,3  (default) "3) Cancel this window"
  184.     ATSAY     15,1  (default) "├────────────────────────────────────────────────────────────────────────────┤"
  185.     IF ISSCRIPT "BBMAINT" and NOT FLAG(3)   ; Not during call
  186.        ATSAY 16,3  (default) "4) Invoke BBS maintenance scripts"
  187.     ELSE
  188.        ATSAY 16,3  (default) ".. Maintenance script not available"
  189.        ENDIF
  190.     IF ISSCRIPT "BBSETUP" and NOT FLAG(3)   ; Not during call
  191.        ATSAY 17,3  (default) "5) Invoke BBS setup script"
  192.     ELSE
  193.        ATSAY 17,3  (default) ".. Setup script not available"
  194.        ENDIF
  195.     ATSAY     18,1  (default) "├────────────────────────────────────────────────────────────────────────────┤"
  196.     ATSAY     19,3  (default) "Select item: "
  197.     ATSAY     20,31 (default) " Press ESC to cancel "
  198.     LOCATE 19,16
  199.     KEYGET S0
  200.     WCLOSE
  201.     LOCATE N98,N97
  202. ;
  203. ;    Interpret the response
  204. ;
  205.     SWITCH S0                ; Interpret resp in S0
  206.        CASE "1"                             ; Terminate
  207.           GOTO End
  208.        ENDCASE
  209.        CASE "2"                             ; Chat
  210.           IF FLAG(3) GOTO Chat
  211.        ENDCASE
  212.        CASE "3"                             ; Bulletin
  213.           RETURN
  214.        ENDCASE
  215.        CASE "4"                             ; Maintenance
  216.           GOSUB EndBBS            ; Terminate BBS
  217.           IF ISFILE "BBMaint" EXECUTE "BBMaint"
  218.        ENDCASE
  219.        CASE "5"                             ; Setup
  220.           GOSUB EndBBS            ; Terminate BBS
  221.           IF ISFILE "BBSetup" EXECUTE "BBSetup"
  222.        ENDCASE
  223.  
  224.        DEFAULT                ; None of the above
  225.           SOUND 100,100            ; Rsapberry
  226.        ENDCASE
  227.     ENDSWITCH
  228.     GOTO Escape
  229. ;
  230. ;    Escape during ESCAPE window
  231. ;
  232. ESC_ESC:
  233.     S0 = "3"                                ; Selection = return
  234.     RETURN                    ; We're done
  235. ;
  236. ; -----------------------------------------------------------------------
  237. ;    Subroutine: End of BBS
  238. ; -----------------------------------------------------------------------
  239. ;
  240. End:
  241.     GOSUB EndBBS
  242.     EXIT
  243. ;
  244. ; -----------------------------------------------------------------------
  245. ;    Subroutine: End of BBS
  246. ; -----------------------------------------------------------------------
  247. ;
  248. EndBBS:
  249.     SET TTHRU OFF            ; Inhibit type thru
  250.     WOPEN 10,1  12,78 (default)
  251.     ATSAY 11,3 (default) "Terminating BBS.. "
  252.  
  253.     HANGUP                ; Hangup the phone
  254.     S9 = "* BBS script terminated"  ; Set msg to log
  255.     CLOG S9             ; Log completion
  256.     GOSUB Log_Item            ; .. both places
  257.     SET DLDIR S28            ; Reset dldir
  258.     CHDIR S29            ; Reset to default directory
  259.     RESET                ; Reset default values
  260.     CLEAR                ; Clear screen
  261.     MESS "BBS terminated... type Alt-X to exit COM-AND^M^J^M^J"
  262.     TRAN "_MINIT"                   ; Initialize modem from defaults
  263.     DELETE "\HOSTTEMP.TXT"          ; Cleanup
  264.  
  265.     WCLOSE
  266.     RETURN                ; We're done
  267. ; -----------------------------------------------------------------------
  268. ;    Subroutine: Chat mode: Operator entered escape
  269. ;
  270. ;    S0 is used as scratch
  271. ; -----------------------------------------------------------------------
  272. ;
  273. Chat:
  274. ;
  275. ;    Start chat mode.
  276. ;
  277.     TRAN "^M^J"                     ; Send a c/r
  278.     TRAN "^M^JOperator initiated chat mode..."
  279.     S2 = "_LEGEND"                  ; Save previous legend
  280.     LEGEND "Scripted BBS (1.1);  Chat mode; null entry at prompt to exit"
  281. ;
  282. ;    Read from the operator
  283. ;
  284. Chat_Loop:
  285.     MESS "^M^JSYSOP: "              ; Prompt
  286.     GET S0 80            ; Read from kbd
  287.  
  288.     IF NULL S0            ; If blank entry
  289.        MESS "Continue? (Y/N, cr=y): "
  290.        GET S0 2            ; Read a response
  291.        IF FIND S0 "N"               ; If response was no
  292.           TRAN "^M^JChat terminated by SYSOP"
  293.           LEGEND S2         ; Restore previous legend
  294.           RETURN            ; Return to what we were doing
  295.           ENDIF
  296.        S0 = " "                     ; Make a blank line
  297.        ENDIF
  298.     TRAN "^M^JSYSOP: "
  299.     TRAN S0             ; Send the line
  300. ;
  301. ;    Read from the caller
  302. ;
  303.     MESS "Caller: "                 ; NO c/r req'd
  304.     TRAN "^M^JCaller: "             ; Prompt
  305.     GOSUB Read_Comm         ; read the comm port
  306.     IF FLAG(0)            ; If caller disconn
  307.        MESS "^M^JCaller disconnected" ; Inform sysop
  308.        LEGEND S2            ; Restore previous legend
  309.        RETURN            ; ANd return
  310.        ENDIF
  311.     GOTO Chat_Loop            ; And continue
  312. ; -----------------------------------------------------------------------
  313. ;    Subroutine: Limit time on-line
  314. ;    .. S6 -> Time of logon
  315. ;    .. N0 -> Max minutes allowed
  316. ;
  317. ;    FLAG(0) off -> Time remaining
  318. ;        on --> Disconnect the caller
  319. ;
  320. ;    S9 and N18,N19 are used as scratch
  321. ; -----------------------------------------------------------------------
  322. ;
  323. Limit_Time:
  324. ;
  325. ;    If privileged user, just return true
  326. ;
  327.     IF FLAG(1)            ; If privileged user
  328.        SET FLAG(0) OFF        ; Return OK
  329.        RETURN            ; Return to caller
  330.        ENDIF
  331. ;
  332. ;    Convert times to numeric quantities
  333. ;
  334.     TIME S9 1            ; Get current time (military fmt)
  335.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight
  336.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight
  337. ;
  338. ;    And test the time remaining
  339. ;
  340.     IF GT N18 N19            ; If timeout on the RGET
  341.        N19 = N19+1440        ; Allow wrap accross midnight
  342.        ENDIF
  343.     N19 = N19-N18            ; COmpute time on
  344.  
  345.     IF GT N19 N0            ; Test against logon determined time
  346.        TRAN "^M^JYour alotted time has expired..."
  347.        TRAN "^M^JYou are being disconnected."
  348.        SET FLAG(0) ON        ; Indicate disconnect
  349.        RETURN            ; RETURN to caller
  350.        ENDIF
  351. ;
  352. ;    Return 'OK'
  353. ;
  354.     SET FLAG(0) OFF         ; Report to caller
  355.     RETURN                ; Return with text in S9
  356. ; -----------------------------------------------------------------------
  357. ;    Subroutine: Read from the caller into S9
  358. ;    .. This handles 'disconnect' and timeouts.
  359. ;
  360. ;    FLAG(0) off -> Line read correctly
  361. ;        on --> Disconnect or timeout
  362. ; -----------------------------------------------------------------------
  363. ;
  364. Read_Comm:
  365. ;
  366. ;    Test timeout
  367. ;
  368.     IF FLAG(3)            ; If user logged on now
  369.        GOSUB Limit_Time        ; Test time on-line
  370.        IF FLAG(0) RETURN        ; If error returns set, end proc here
  371.        ENDIF
  372. ;
  373. ;    Now, sit on the COMM port waiting for a read
  374. ;
  375.     RGET S9 80 180            ; Wait for a connection
  376.     IF NOT CONNECTED GOTO Disconnect; If modem reports CD dropped
  377.     IF FAILED GOTO Timeout        ; If timeout on the RGET issue msg and disconn
  378.     FIND S9 "NO CARRIER"            ; Test for message from modem
  379.     IF FOUND GOTO Disconnect    ; If modem didn't report 'CD' true
  380. ;
  381. ;    Return 'text read'
  382. ;
  383.     SET FLAG(0) OFF         ; Report to caller
  384.     RETURN                ; Return with text in S9
  385. ;
  386. ;    Timeout on the call
  387. ;
  388. Timeout:
  389.     TRAN "^M^J... autodisconnect due to timeout^M^J"
  390.     MESSAGE "^M^J... autodisconnect due to timeout"
  391.     GOTO RComm_Exit         ; Exit cycle in the usual manner
  392. ;
  393. ;    Disconnect was reported.
  394. ;
  395. Disconnect:
  396.     MESSAGE  "^M^JCaller disconnected"
  397. ;
  398. ;    Read_Comm error exit
  399. ;
  400. RComm_Exit:
  401.     SET FLAG(0) ON            ; Report to caller
  402.     RETURN                ; Return to the caller
  403. ; -----------------------------------------------------------------------
  404. ;    Subroutine: Display the # of allotted minutes remaining
  405. ;    .. S6 -> Time of logon
  406. ;    .. N0 -> Max minutes allowed
  407. ;
  408. ;    S9 and N18,N19 are used as scratch
  409. ; -----------------------------------------------------------------------
  410. ;
  411. Display_Limit:
  412. ;
  413. ;    If privileged user, just return (no message)
  414. ;
  415.     IF FLAG(1) RETURN        ; If privileged user, rtn to caller
  416. ;
  417. ;    Convert times to numeric quantities
  418. ;
  419.     TIME S9 1            ; Get current time (military fmt)
  420.     N19 = S9(0:1)*60+S9(3:4)    ; Compute current time since midnight
  421.     N18 = S6(0:1)*60+S6(3:4)    ; Time of logon since midnight
  422. ;
  423. ;    Compute the time remaining
  424. ;
  425.     IF GT N18 N19            ; If timeout on the RGET
  426.        N19 = N19+1440        ; Allow wrap accross midnight
  427.        ENDIF
  428.     N19 = N0-(N19-N18)        ; Compute remaining time
  429. ;
  430. ;    Display the quantity and we're done
  431. ;
  432.     STRFMT S9 "^M^J(%d minutes remaining)" N19
  433.     TRAN S9
  434.     RETURN                ; Return with text in S9
  435. ; -----------------------------------------------------------------------
  436. ;    Subroutine: Logon - ID/password are in S1 (0:15)
  437. ;
  438. ;    On exit:
  439. ;       FLAG(0) ON -> indicate falure of logon
  440. ;       FLAG(1) ON -> if logon successful to indicate privileged access
  441. ; -----------------------------------------------------------------------
  442. ;
  443. Logon:
  444.     FOPENI "BBS-User" TEXT          ; OPEN file for input
  445.     IF FAILED            ; if open failed
  446.        SET FLAG(0) ON        ; Report an error
  447.        RETURN            ; Return to caller
  448.        ENDIF
  449. ;
  450. ;    Read records from BBS-User
  451. ;
  452. Logon_Loop:
  453.     READ S9 80 N19            ; Read a record      * COM-AND
  454.     IF EOF                ; Test for EOF
  455.        FCLOSEI            ; CLose the input file
  456.        SET FLAG(0) ON        ; Report an error
  457.        RETURN            ; Return to caller
  458.        ENDIF
  459.  
  460.     FIND S9(0:0) "<"                ; Test for comment line
  461.     IF FOUND GOTO Logon_Loop    ; IF "<" found,
  462.  
  463.     SWITCH S1            ; Test ID/Password
  464.        CASE S9(0:15)        ; .. against record
  465.           GOTO Logon_OK        ; We have a match
  466.        ENDCASE
  467.     ENDSWITCH
  468.     GOTO Logon_Loop         ; Read the next record
  469. ;
  470. ;    We have a successful logon
  471. ;
  472. Logon_OK:
  473.     SET FLAG(1) OFF         ; Default no privilege
  474.     SET FLAG(3) ON            ; Set flag to say 'logged-on'
  475.     N0 = 60             ; Set time limit for non-privileged user
  476.  
  477.     FIND S9(16:16) "P"              ; Test for privilege
  478.     IF FOUND            ; IF "P" found,
  479.        SET FLAG(1) ON        ; Indicate privilege
  480.        N0 = 3000            ; 50 hours ought to be enough
  481.        ENDIF
  482.  
  483.     TIME S6 1            ; Set time of logon (military fmt)
  484.  
  485.     FCLOSEI             ; CLose the input file
  486.     SET FLAG(0) OFF         ; Indicate successful logon
  487.     RETURN
  488. ; -----------------------------------------------------------------------
  489. ;    Subroutine: DispFile: Display a file
  490. ;
  491. ;    On entry:
  492. ;       S8 -> The file to be opened (and displayed)
  493. ;       S9 -> A message to be displayed if the file D.N.E
  494. ; -----------------------------------------------------------------------
  495. ;
  496. Disp_File:
  497.     IF ISFILE S8            ; If File exists
  498.        TRAN "^M^J"                  ; Send an initial delimiter
  499.        SENDFILE ASCII S8        ; Send the file
  500.        RETURN            ; Return to caller
  501.        ENDIF
  502.  
  503.     IF ISFILE S22&"\"*S8            ; If file exists on primary subdir
  504.        TRAN "^M^J"                  ; Send an initial delimiter
  505.        SENDFILE ASCII S22&"\"*S8    ; Send the file
  506.        RETURN            ; Return to caller
  507.        ENDIF
  508.  
  509.     TRAN S9             ; Display the alternative message
  510.     RETURN                ; Return to caller
  511. ; -----------------------------------------------------------------------
  512. ;    Subroutine: Log_Item: Add a line to the activity log
  513. ;
  514. ;    On entry:
  515. ;       S9 -> The line to be added
  516. ;
  517. ;    S7 is used as a scratch reg; S9 is modified
  518. ; -----------------------------------------------------------------------
  519. ;
  520. Log_Item:
  521.     FOPENO S22&"\BBS-LOG" TEXT APPEND ; OPEN file for output
  522.     IF FAILED RETURN        ; If open failed, rtn here
  523.  
  524.     DATE S7             ; Get current date
  525.     CONCAT S9(59) S7        ; Add date to S9 line
  526.     TIME S7 1            ; Get current time (military fmt)
  527.     CONCAT S9(70) S7        ; Add time to S9 line
  528.  
  529.     WRITE S9            ; Write a record     * COM-AND
  530.     WRITE "^M"                      ; Write a cr/lf          * COM-AND
  531.     FCLOSEO             ; CLose the output file
  532.     RETURN                ; And we're done
  533. ;
  534. ; -----------------------------------------------------------------------
  535. ;    Subroutine: Copy text to an open file (write a message)
  536. ;    The output file must be opened by the caller
  537. ;
  538. ;    S9, N18 are used as scratch
  539. ;    N20 carries the current linenum (and must be preserved on GOSUBs)
  540. ; -----------------------------------------------------------------------
  541. ;
  542. Copy_Text:
  543.     N20 = 0
  544. ;
  545. ;    Prompt with a line number, and read a line of text in response
  546. ;
  547. Copy_Loop:
  548.     INC N20             ; Increment line counter
  549.     S9 = N20 & ":  ^H"              ; Convert to decimal ascii
  550.     TRAN S9             ; Transmit line number
  551.  
  552.     GOSUB Read_Comm         ; Read a response
  553.     IF FLAG(0) RETURN        ; If error, make end of text
  554. ;
  555. ;    If the line is not blank, copy it to the output file
  556. ;
  557.     LENGTH S9 N18            ; Get proper length
  558.     IF NOT ZERO N18         ; Test for an empty line
  559.        PRESERVE S9            ; Preserve "!"s and "^"s
  560.        WRITE S9            ; Write the line     * COM-AND
  561.        IF FAILED            ; if write failed
  562.           TRAN "Error recording text - please try later^M^J"
  563.           RETURN            ; Return to caller
  564.           ENDIF
  565.        WRITE  "!"                   ; And a record delimiter * COM-AND
  566.        GOTO Copy_Loop        ; And loop
  567. ;
  568. ;    A blank line was entered - ask if we are to terminate
  569. ;
  570.     ELSE
  571.        TRAN "^M^JComplete? (Y/N, cr=n): "  ; Ask if this is end of input
  572.        GOSUB Read_Comm        ; Read a response
  573.        IF FLAG(0) RETURN        ; If error - disconn
  574.        IF NOT FIND S9 "Y"           ; Test for positive response
  575.           WRITE "!"                 ; Write a blank line
  576.           GOTO Copy_Loop        ; COntinue copying
  577.           ENDIF
  578.        ENDIF
  579.     RETURN                ; Return - we're done
  580. ; -----------------------------------------------------------------------
  581. ; ----- Begin ... reset values, and set the modem to accept a call
  582. ; -----------------------------------------------------------------------
  583. ;
  584. Restart:
  585.     CHDIR S22            ; Reset to default drive
  586.     SET RECHO OFF            ; Turn off echo for us
  587.     SET RDISP OFF            ; Turn on display of received chars
  588.     CLEAR                ; Clear screen
  589.     LOCATE 0,0            ; Set to home
  590.  
  591.     SET FLAG(1) OFF         ; Turn off privilege flag
  592.     SET FLAG(2) OFF         ; Turn off CHDIR flag
  593.     SET FLAG(3) OFF         ; Turn off logged-on flag
  594. ;
  595. ;    Go into auto answer (echo off, answer on 3rd)
  596. ;    Also: Return result codes, word form, with CONNECT 1200
  597. ;
  598.     HANGUP                ; HANGUP and leave modem in cmd mode
  599.     MESSAGE "^M^JWaiting..."
  600.     PAUSE 3             ; Wait 3 secs
  601.     SET BAUD S20(5:8)        ; Starting speed
  602.     TRANSMIT S21            ; Transmit modem initialization
  603. ;
  604. ; -----------------------------------------------------------------------
  605. ; ----- Wait for a connect
  606. ; -----------------------------------------------------------------------
  607. ;
  608. Wait_Connect:
  609.     RGET S9 80 180            ; Wait for a line
  610.     IF FAILED GOTO Wait_Connect    ; If nothing was read
  611.  
  612.     FIND S9 "NO CARRIER"            ; Look for a disconn
  613.     IF FOUND GOTO Restart
  614.  
  615.     FIND S9 "CONNECT"               ; Anything else BUT CONNECT
  616.     IF NOT FOUND GOTO Wait_Connect    ; .. waits
  617. ;
  618. ; ----- Connection established: Adjust our linespeed if need be
  619. ;
  620.     GOSUB AutoBaud            ; Change rate according to CONNECT MSG
  621. ;
  622. ; ----- Issue a greeting
  623. ;
  624.     PAUSE 3             ; Let the modem settle
  625.     RFLUSH                ; Clear line
  626.  
  627.     SET RECHO ON            ; Turn on echo (echo back to caller)
  628.     SET RDISP ON            ; Turn on display of received chars
  629.     PAUSE 1             ; MOdem settling
  630.  
  631.     S9 = "^M^JThe Flying Scotsman greets you!! ^M^J"
  632.     S8 = "BBS-Welc"                 ; Set file name
  633.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  634.  
  635.     N10 = 0             ; Set count of logon tries
  636. ;
  637. ; ----- Request an ID
  638. ;
  639. ID_Query:
  640.     MESS "^M^JID prompt: "          ; Local console indicator
  641.     TRANSMIT "^M^JEnter your ID (or enter GUEST): "
  642.     GOSUB Read_Comm         ; Read into S9
  643.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn
  644.  
  645.     IF NULL S9            ; Test for nothing entered
  646.        INC N10            ; Count it as a logon try
  647.        IF GE N10 3 GOTO Logon_Fail    ; If tried 3 times to logon quit
  648.        GOTO ID_Query        ; Require an ID
  649.        ENDIF            ; End of empty test
  650.  
  651.     SWITCH S9
  652.        CASE "GUEST"                 ; Test for nothing entered
  653.           GOSUB Register        ; Try to register the caller
  654.           GOTO Exit         ; And exit the sequence
  655.        ENDCASE            ; End of GUEST test
  656.     ENDSWITCH            ; End of ID test
  657.     S1 = S9(0:7)            ; Save 8 chars of ID
  658.     UPPER S1            ; Make ID upper case
  659. ;
  660. ; ----- Request a password
  661. ;
  662. Password_Query:
  663.     TRANSMIT "^M^JEnter your password: "
  664.     SET RECHO OFF            ; Turn of echo of received text
  665.     SET RDISPLAY OFF        ; Turn off echo to console too
  666.  
  667.     GOSUB Read_Comm         ; Read into S9
  668.     SET RECHO ON            ; Restore echo
  669.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn
  670.     SET RDISPLAY ON         ; Turn on echo to console again
  671.  
  672.     IF NULL S9            ; Test for nothing entered
  673.        INC N10            ; Count it as a logon try
  674.        IF GE N10 3 GOTO Logon_Fail    ; If tried 3 times to logon quit
  675.        GOTO Password_Query        ; Require a password
  676.        ENDIF            ; End of empty test
  677. ;
  678. ;    Build the ID/password string and test logon
  679. ;
  680.     S1(8:79) = S9(0:7)        ; Add password to S1
  681.     GOSUB Logon            ; Test logon
  682.     IF NOT FLAG(0)            ; If flag(0) returns reset, its ok
  683.        S9 = "Logon: "*S1(0:7)       ; Set activity
  684.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  685.        SET FLAG(2) OFF        ; Indicate no CHDIR this user
  686.        S1 = S1(0:7)         ; Throw away password
  687.        CLOG "* BBS logon: "*S1
  688.        TRAN "^M^J"                  ; Space one line fror caller
  689.        GOTO Main_Prompt        ; OK - we're on
  690.        ENDIF
  691. ;
  692. ;    Unrecognized ID/password
  693. ;
  694. Logon_Fail:
  695.     TRAN "Unrecognized ID/Password^M^J"
  696.     INC N10             ; Increment count of tries
  697.     IF GE N10 3            ; If tried 3 times to logon
  698.        TRAN "You have exceeded the number of tries allowed for logon^M^JBye...^M^J"
  699.        MESS "^M^JLogon attempts failed^M^J"
  700.        S9 = "Failed logon"          ; Report to log
  701.        GOSUB Log_Item
  702.        GOTO Exit            ; ANd hangup
  703.        ENDIF
  704.     GOTO ID_Query            ; And try again
  705. ; -----------------------------------------------------------------------
  706. ; ----- Main Loop: Prompt for a command and interpret the return
  707. ; -----------------------------------------------------------------------
  708. ;
  709. Main_Prompt:
  710.     MESS "^M^JMain prompt: "        ; Local console indicator
  711.     GOSUB Display_Limit        ; Report amount of time remaining
  712.  
  713.     IF NOT FLAG(1)            ; According to privilege
  714.        S9 = "^M^JC)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  715.        S8 = "BBS-NpMn"              ; Set file name
  716.     ELSE
  717.        S9 = "^M^JP)rivileged, C)omment, B)ulletins, M)ail, F)iles, A)larm or E)xit: "
  718.        S8 = "BBS-PrMn"              ; Set file name
  719.        ENDIF
  720.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  721. ;
  722. ;    Keep just the first char entered
  723. ;
  724.     GOSUB Read_Comm         ; Read into S9
  725.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  726.  
  727.     LJ S9                ; Left justify S9
  728.     S9 = S9(0:0)            ; Keep just the first char
  729. ;
  730. ;    Perform commands
  731. ;
  732.     SWITCH S9            ; Test the entry
  733.     ;
  734.     ;    Alarm
  735.     ;
  736.        CASE "A"                     ; Signal request for chat mode
  737.           GOTO Alarm
  738.        ENDCASE
  739.     ;
  740.     ;    Mail
  741.     ;
  742.        CASE "M"                     ; Messages
  743.           GOTO Mail_Command
  744.        ENDCASE
  745.     ;
  746.     ;    Files command
  747.     ;
  748.        CASE "F"                     ; Files
  749.           GOTO File_Command
  750.        ENDCASE
  751.     ;
  752.     ;    Comment command
  753.     ;
  754.        CASE "C"                     ; Leave a note
  755.           GOTO Comment
  756.        ENDCASE
  757.     ;
  758.     ;    Bulletin command
  759.     ;
  760.        CASE "B"                     ; Read bulletins
  761.           GOTO Bull_Command
  762.        ENDCASE
  763.     ;
  764.     ;    Exit command
  765.     ;
  766.        CASE "E"                     ; Exit
  767.           GOTO Logoff        ; Transmit acknowlegement and Exit
  768.        ENDCASE
  769.     ;
  770.     ;    Privileged command
  771.     ;
  772.        CASE "P"                     ; Privilege
  773.           IF FLAG(1) GOTO Priv_Prompt; Execute only if privileged
  774.        ENDCASE
  775.     ENDSWITCH
  776. ;
  777. ;    Invalid command
  778. ;
  779.     TRAN "^M^JCommand not recognized... try again^M^J"
  780.     GOTO Main_Prompt
  781. ;
  782. ; -----------------------------------------------------------------------
  783. ;    Logoff
  784. ; -----------------------------------------------------------------------
  785. ;
  786. Logoff:
  787.     CHDIR S22            ; Set to our subdirectory
  788.     TRAN "^M^JOK... Bye^M^J"        ; Say g'bye and fall thru to Exit
  789.     S9 = "Logoff: "*S1(0:7)         ; Set activity
  790.     CLOG S9             ; Log here too
  791.     GOSUB Log_Item            ; Add S9 to BBS-LOG
  792. ;
  793. ; -----------------------------------------------------------------------
  794. ;    General exit routine - don't GOTO from within a subroutine!!!
  795. ; -----------------------------------------------------------------------
  796. ;
  797. Exit:
  798.     S9 = "* BBS cycled"             ; Set activity
  799.     CLOG S9             ; Call log it too
  800.     GOSUB Log_Item            ; Add S9 to BBS-LOG
  801.     MESS "^G"                       ; Beep console to indicate exit
  802.     GOTO Restart            ; And start over
  803. ;
  804. ; -----------------------------------------------------------------------
  805. ;    Alarm routine - make some noise, in hopes we can upset somebody
  806. ; -----------------------------------------------------------------------
  807. ;
  808. Alarm:
  809.     SOUND 440 500            ; 1/2 sec  Scale in 'A'
  810.     SOUND 493 100            ; 1/10 sec
  811.     SOUND 554 100            ; 1/10 sec
  812.     SOUND 587 100            ; 1/10 sec
  813.     SOUND 659 100            ; 1/10 sec
  814.     SOUND 739 100            ; 1/10 sec
  815.     SOUND 830 100            ; 1/10 sec
  816.     SOUND 880 500            ; 1/2 sec
  817.     GOTO Main_Prompt        ; And start over
  818. ; -----------------------------------------------------------------------
  819. ; ----- Privileged commands submenu.
  820. ; -----------------------------------------------------------------------
  821. ;
  822. Priv_Prompt:
  823.     MESS "^M^JPrivilege prompt: "   ; Local console indicator
  824.     GOSUB Display_Limit        ; Report amount of time remaining
  825.     S9 = "^M^JL)ist, P)ath, S)ubdir, D)OS, M)ain or E)xit: "
  826.     S8 = "BBS-PPMn"                 ; Set file name
  827.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  828. ;
  829. ;    Keep just the first char entered
  830. ;
  831.     GOSUB Read_Comm         ; Read into S9
  832.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  833.  
  834.     LJ S9                ; Left justify S9
  835.     S9 = S9(0:0)            ; Keep just the first char
  836. ;
  837. ;    Execute a command
  838. ;
  839.     SWITCH S9            ; Test the entry
  840.     ;
  841.     ;    List command
  842.     ;
  843.        CASE "L"                     ; List
  844.           GOTO DIR
  845.        ENDCASE
  846.     ;
  847.     ;    Subdir command
  848.     ;
  849.        CASE "S"                     ; Chdir
  850.           GOTO CHDIR
  851.        ENDCASE
  852.     ;
  853.     ;    Pathlist command
  854.     ;
  855.        CASE "P"                     ; Pathlist
  856.           GOTO PATHLIST
  857.        ENDCASE
  858.     ;
  859.     ;    Shell command
  860.     ;
  861.        CASE "D"                     ; Shell
  862.           GOTO Shell
  863.        ENDCASE
  864.     ;
  865.     ;    Main command
  866.     ;
  867.        CASE "M"                     ; Go back to main prompt
  868.           GOTO Main_Prompt
  869.        ENDCASE
  870.     ;
  871.     ;    Exit command
  872.     ;
  873.        CASE "E"                     ; Exit
  874.           GOTO Logoff        ; Transmit acknowlegement and Exit
  875.        ENDCASE
  876.     ENDSWITCH
  877. ;
  878. ;    Invalid command
  879. ;
  880.     TRAN "^M^JCommand not recognized... try again^M^J"
  881.     GOTO Priv_Prompt
  882. ; -----------------------------------------------------------------------
  883. ;    Privileged user: CHDIR... Query for a path.
  884. ; -----------------------------------------------------------------------
  885. ;
  886. CHDIR:
  887.     MESS "^M^JCHDIR Command: "      ; Local console indicator
  888.     TRAN "^M^JEnter the drive:subdirectory: "
  889.  
  890.     GOSUB Read_Comm         ; Read into S9
  891.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  892.  
  893.     IF NOT NULL S9            ; If something entered
  894.        CHDIR S9            ; Do it.
  895.        SET FLAG(2) ON        ; Save the fact we've done a CHDIR
  896.        ENDIF
  897.     GOTO Priv_Prompt        ; And continue
  898. ; -----------------------------------------------------------------------
  899. ;    Privileged user: Path tree... awkward... but it works
  900. ; -----------------------------------------------------------------------
  901. ;
  902. PATHLIST:
  903.     MESS "^M^JPathlist command: "   ; Local console indicator
  904.     TRAN "^M^JWorking..."           ; May take a moment
  905.  
  906.     DOS "TREED >\HOSTTEMP.TXT"      ; To a temp file
  907.  
  908.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  909.     SENDFILE ASCII "\HOSTTEMP.TXT"
  910.     TRAN "^M^J"                     ; Send a c/r
  911.  
  912.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  913.     GOTO Priv_Prompt        ; And continue
  914. ; -----------------------------------------------------------------------
  915. ;    Privileged user: DOS SHELL... Query for a command
  916. ; -----------------------------------------------------------------------
  917. ;
  918. Shell:
  919.     MESS "^M^JDOS Command: "        ; Local console indicator
  920.     TRAN "^M^JWarning: this command may be used to invoke ANY COMMAND that"
  921.     TRAN "^M^JDOS can execute.  If you load a program requiring keyboard  "
  922.     TRAN "^M^Jentry, you lock yourself out and leave the board unusable."
  923.     TRAN "^M^J"
  924.     TRAN "^M^JEnter your command: "
  925.  
  926.     GOSUB Read_Comm         ; Read into S9
  927.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  928.  
  929.     IF NULL S9            ; If nothing entered
  930.        GOTO Priv_Prompt        ; User decided better
  931.        ENDIF
  932.  
  933.     IF FIND S9 "FORMAT"             ; Disallow any format commands
  934.        TRAN "^M^JFormat commands are not allowed..."
  935.        GOTO Priv_Prompt        ; And continue
  936.        ENDIF
  937. ;
  938. ;    Perform it
  939. ;
  940.     TRAN "^M^JWorking..."           ; May take a moment
  941.  
  942.     CONCAT S9 ">\HOSTTEMP.TXT"
  943.     DOS   S9            ; Do it.
  944.  
  945.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  946.     SENDFILE ASCII "\HOSTTEMP.TXT"
  947.     TRAN "^M^J"                     ; Send a c/r
  948.  
  949.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  950.     GOTO Priv_Prompt        ; And continue
  951. ; -----------------------------------------------------------------------
  952. ;    Directory list... awkward... but it works
  953. ; -----------------------------------------------------------------------
  954. ;
  955. Dir:
  956.     MESS "^M^JDirectory command: "  ; Local console indicator
  957.     TRAN "^M^JWorking..."           ; May take a moment
  958.  
  959.     DOS "DIR >\HOSTTEMP.TXT"        ; To a temp file
  960.     TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  961.     SENDFILE ASCII "\HOSTTEMP.TXT"
  962.     TRAN "^M^J"                     ; Send a c/r
  963.  
  964.     DELETE "\HOSTTEMP.TXT"          ; Clean up after us
  965.     GOTO Priv_Prompt        ; And continue
  966. ; -----------------------------------------------------------------------
  967. ;    Files command: File list, Upload, download or back to main
  968. ;
  969. ;    Note: S19 must be retained throughout this submenu...
  970. ;          It is used to save the current subdir
  971. ; -----------------------------------------------------------------------
  972. ;
  973. File_Command:
  974.     MESS "^M^JFile prompt: "        ; Local console indicator
  975.     SUBDIR S19            ; Save current subdir
  976.     CHDIR S23            ; Set to default subdir
  977. ;
  978. ;    Prompt for a command
  979. ;
  980. File_Prompt:
  981.     GOSUB Display_Limit        ; Report amount of time remaining
  982.     S9 = "^M^JL)ist, S)earch, U)pload, D)ownload, M)ain or E)xit: "
  983.     S8 = "BBS-FiMe"                 ; Set file name
  984.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  985. ;
  986. ;    Keep just the first char entered
  987. ;
  988.     GOSUB Read_Comm         ; Read into S9
  989.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  990.  
  991.     LJ S9                ; Left justify S9
  992.     S9 = S9(0:0)            ; Keep just the first char
  993. ;
  994. ;    Interpret the command
  995. ;
  996.     SWITCH S9            ; Test the entry
  997.     ;
  998.     ;    Download command
  999.     ;
  1000.        CASE "D"                     ; Download
  1001.           GOTO DOWNLOAD
  1002.        ENDCASE
  1003.     ;
  1004.     ;    Upload command
  1005.     ;
  1006.        CASE "U"                     ; Upload
  1007.           GOTO UPLOAD
  1008.        ENDCASE
  1009.     ;
  1010.     ;    List command
  1011.     ;
  1012.        CASE "L"                     ; File list
  1013.           GOTO FILELIST
  1014.        ENDCASE
  1015.     ;
  1016.     ;    Search command
  1017.     ;
  1018.        CASE "S"                     ; Search list
  1019.           GOTO Search
  1020.        ENDCASE
  1021.     ;
  1022.     ;    Main command
  1023.     ;
  1024.        CASE "M"                     ; Go back to main prompt
  1025.           CHDIR S19         ; Reset subdir
  1026.           GOTO Main_Prompt
  1027.        ENDCASE
  1028.     ;
  1029.     ;    Exit command
  1030.     ;
  1031.        CASE "E"                     ; Exit
  1032.           GOTO Logoff        ; Transmit acknowlegement and Exit
  1033.        ENDCASE
  1034.     ENDSWITCH
  1035.  
  1036.     TRAN "Invalid selection - try again^M^J"
  1037.     GOTO FILE_Prompt
  1038. ; -----------------------------------------------------------------------
  1039. ;    Subroutine: Query for a file name - return in S8
  1040. ;    On exit:
  1041. ;       FLAG(0) Returned ON to indicate caller disconn/timedout
  1042. ; -----------------------------------------------------------------------
  1043. ;
  1044. File_Query:
  1045.     MESS "^M^JFname query: "        ; Local console indicator
  1046.     TRAN "^M^JEnter the file name: "
  1047.  
  1048.     GOSUB Read_Comm         ; Read into S9
  1049.     RETURN                ; Return to caller (w/flag(0) set)
  1050. ;
  1051. ; -----------------------------------------------------------------------
  1052. ;    XMODEM Upload (up from caller)
  1053. ;
  1054. ;    Files unqualified by drive:subdir are placed in the default
  1055. ;    DLOAD subdirectory.
  1056. ;
  1057. ;    Note: Qualified names (containing subdir) are permitted
  1058. ;          only if the privilege flag (FLAG(1)) is set.
  1059. ; -----------------------------------------------------------------------
  1060. ;
  1061. UPLOAD:
  1062.     MESS "^M^JUpload from caller "
  1063.  
  1064.     GOSUB File_Query        ; Ask for a file name
  1065.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1066.  
  1067.     IF NULL S9            ; If no file returned
  1068.        GOTO File_Prompt        ; .. start over
  1069.        ENDIF            ; ..
  1070.  
  1071.     IF FIND S9 "\" and NOT FLAG(1)  ; Test for subdir in name and privilege
  1072.        TRAN "^M^JQualified file names are not permitted."
  1073.        GOTO UPLOAD            ; Ask again
  1074.        ENDIF
  1075.  
  1076.     IF ISDLFILE S9            ; If file exists in DL subdir
  1077.        TRAN "^M^JFile already exists"
  1078.        GOTO UPLOAD            ; Ask again
  1079.        ENDIF
  1080. ;
  1081. ;    Prompt for a method
  1082. ;
  1083.     MESS "^M^JUlo Method prompt: "  ; Local console indicator
  1084.     TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, or K)ermit: "
  1085.  
  1086.     S8 = S9             ; Save file name
  1087. ;
  1088. ;    Keep just the first char entered
  1089. ;
  1090.     GOSUB Read_Comm         ; Read into S9
  1091.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1092.  
  1093.     LJ S9                ; Left justify S9
  1094.     S9 = S9(0:0)            ; Keep just the first char
  1095. ;
  1096. ;    Interpret the response
  1097. ;
  1098.     TIME S10 1            ; Save start of upload time
  1099.     SWITCH S9            ; Test the entry
  1100.        CASE "W"
  1101.           TRAN "^M^JBegin your transfer procedure..."
  1102.           GETFILE WXMODEM S8
  1103.        ENDCASE
  1104.        CASE "X"
  1105.           TRAN "^M^JBegin your transfer procedure..."
  1106.           GETFILE XMODEM S8
  1107.        ENDCASE
  1108.        CASE "Y"
  1109.           TRAN "^M^JBegin your transfer procedure..."
  1110.           GETFILE YMODEM S8
  1111.        ENDCASE
  1112.        CASE "Z"
  1113.           TRAN "^M^JBegin your transfer procedure..."
  1114.           GETFILE ZMODEM
  1115.        ENDCASE
  1116.        CASE "K"
  1117.           TRAN "^M^JBegin your transfer procedure..."
  1118.           GETFILE KERMIT        ; FIle name supplied by caller
  1119.        ENDCASE
  1120.        DEFAULT
  1121.           TRAN "^M^JInvalid transfer selection"
  1122.           SET SUCCESS OFF
  1123.           GOTO EOTransfer
  1124.        ENDCASE
  1125.     ENDSWITCH
  1126. ;
  1127. ;    Log the transfer
  1128. ;
  1129.     IF FAILED
  1130.        S9 = "Upload ("*S9(0:0)*"): "*S8&", Failure"
  1131.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  1132.        DELETE S8            ; Delete parial file
  1133.        SET SUCCESS OFF        ; Control msg to console
  1134.        GOTO EOTransfer
  1135.     ELSE
  1136.        S9 = "Upload ("*S9(0:0)*"): "*S8&", Success"
  1137.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  1138.        ENDIF
  1139. ;
  1140. ;    A file uploaded with subdirectory doesn't get logged
  1141. ;
  1142.     IF FIND S8 "\"                  ; Test for subdir in name
  1143.        GOTO File_Prompt        ; Skip logging it
  1144.        ENDIF
  1145. ;
  1146. ;    Convert times to numeric quantities
  1147. ;
  1148.     TIME S11 1            ; Get current time (military fmt)
  1149.     N19 = S11(0:1)*60+S11(3:4)    ; Compute current time since midnight
  1150.     N18 = S10(0:1)*60+S10(3:4)    ; Time of upload since midnight
  1151. ;
  1152. ;    Compute the time remaining and add it to the max
  1153. ;
  1154.     IF GT N18 N19            ; If timeout on the RGET
  1155.        N19 = N19+1440        ; Allow wrap accross midnight
  1156.        ENDIF
  1157.     N0 = N0+(N19-N18)        ; Compute time to upload and add it in
  1158. ;
  1159. ;    At this point, ask for a description for the file
  1160. ;
  1161. Describe:
  1162.     TRAN "^M^JDescription: "        ; Prompt
  1163.     GOSUB Read_Comm         ; Read response
  1164.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1165.  
  1166.     IF NULL S9            ; If nothing entered
  1167.        TRAN "^M^JPlease leave something of a description"
  1168.        GOTO Describe        ; Try again
  1169.        ENDIF
  1170. ;
  1171. ;    Open the file list, and append the file
  1172. ;
  1173.     FOPENO "BBS-File"  TEXT APPEND  ; Open the file to append
  1174.     IF FAILED
  1175.        S9 = "Uload of "*S8&" succeeded, but BBS-FIle open failed"
  1176.        GOSUB Log_Item        ; Log it
  1177.        SET SUCCESS OFF        ; Indicate failure for console
  1178.        GOTO EOTransfer        ; If error, exit
  1179.        ENDIF
  1180. ;
  1181. ;    Build a record for BBS-FIle
  1182. ;
  1183.     DATE S0             ; Get the current date
  1184.     S8 = S8 & "            "        ; Ensure blank padding
  1185.     FSIZE S11 S8            ; Get file size using fname
  1186.     S10 = S8(0:11) * S0(0:7) *" "* S11(0:6) * S9
  1187.     WRITE S10            ; write the record
  1188.     WRITE "!"                       ; Write a delimiter
  1189.  
  1190.     FCLOSEO             ; Close the output file
  1191.     SET SUCCESS ON            ; Indicate success
  1192.     GOTO EOTransfer         ; Report success/failure
  1193. ; -----------------------------------------------------------------------
  1194. ;    XMODEM Download (down to caller)
  1195. ;
  1196. ;    Download occurs from the default drive:subdir unless explicitly
  1197. ;    qualified.
  1198. ;
  1199. ;    Note: Qualified names (containing subdir) are permitted
  1200. ;          only if the privilege flag (FLAG(1)) is set.
  1201. ; -----------------------------------------------------------------------
  1202. ;
  1203. DOWNLOAD:
  1204.     MESS "^M^JDownload to caller "
  1205.  
  1206.     GOSUB File_Query        ; Ask for a file name
  1207.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1208.  
  1209.     IF NULL S9 GOTO File_Prompt    ; If no file returned, start over
  1210.     IF FIND S9 "\"                  ; Test for subdir
  1211.        IF NOT FLAG(1)        ; Test for privilege
  1212.           TRAN "^M^JQualified file names are not permitted."
  1213.           GOTO DOWNLOAD        ; Ask again
  1214.           ENDIF
  1215.        ENDIF
  1216.  
  1217.     IF NOT ISFILE S9        ; If file doesn't exist
  1218.        GOSUB FileTest        ; Look in BBS-File
  1219.        IF FAILED            ; If not found
  1220.           TRAN "^M^JFile doesn't exist"
  1221.           GOTO DOWNLOAD        ; Ask again
  1222.           ENDIF            ; Else S9 contains file name
  1223.        ENDIF
  1224.     S8 = S9             ; Save file name
  1225. ;
  1226. ;    Prompt for a method
  1227. ;
  1228.     MESS "^M^JDlo Method prompt "
  1229.     TRAN "^M^JW)xmodem, X)modem, Y)modem (X1k), Z)modem, K)ermit, or A)scii: "
  1230. ;
  1231. ;    Keep just the first char entered
  1232. ;
  1233.     GOSUB Read_Comm         ; Read into S9
  1234.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1235.  
  1236.     LJ S9                ; Left justify S9
  1237.     S9 = S9(0:0)            ; Keep just the first char
  1238. ;
  1239. ;    Interpret the response
  1240. ;
  1241.     SWITCH S9            ; Test the entry
  1242.        CASE "A"
  1243.           TRAN "^M^JUse control-S to suspend, control-Q to continue^M^J"
  1244.           SENDFILE ASCII S8
  1245.        ENDCASE
  1246.        CASE "W"
  1247.           TRAN "^M^JBegin your transfer procedure..."
  1248.           SENDFILE WXMODEM S8
  1249.        ENDCASE
  1250.        CASE "X"
  1251.           TRAN "^M^JBegin your transfer procedure..."
  1252.           SENDFILE XMODEM S8
  1253.        ENDCASE
  1254.        CASE "Y"
  1255.           TRAN "^M^JBegin your transfer procedure..."
  1256.           SENDFILE YMODEM S8
  1257.        ENDCASE
  1258.        CASE "Z"
  1259.           TRAN "^M^JBegin your transfer procedure..."
  1260.           SENDFILE ZMODEM S8
  1261.        ENDCASE
  1262.        CASE "K"
  1263.           TRAN "^M^JBegin your transfer procedure..."
  1264.           SENDFILE KERMIT S8
  1265.        ENDCASE
  1266.        DEFAULT
  1267.           TRAN "^M^JInvalid transfer selection"
  1268.           SET SUCCESS OFF        ; Indicate failure for console
  1269.           GOTO EOTransfer
  1270.        ENDCASE
  1271.     ENDSWITCH
  1272. ;
  1273. ;    Log the download
  1274. ;
  1275.     IF FAILED
  1276.        S9 = "Download ("*S9(0:0)*"): "*S8&", Failure"
  1277.        GOSUB Log_Item    ; Add S9 to BBS-LOG
  1278.        SET SUCCESS OFF
  1279.     ELSE
  1280.        S9 = "Download ("*S9(0:0)*"): "*S8&", Success"
  1281.        GOSUB Log_Item        ; Add S9 to BBS-LOG
  1282.        SET SUCCESS ON
  1283.        ENDIF
  1284. ;
  1285. ;    End of transfer... note result on local console
  1286. ;
  1287. EOTransfer:
  1288.     IF FAILED
  1289.        MESS "^M^JTransfer failed "
  1290.     ELSE
  1291.        MESS "^M^JTransfer OK "
  1292.        ENDIF
  1293.     GOTO File_Prompt
  1294. ; -----------------------------------------------------------------------
  1295. ;    FileTest - take qualification for fname from description
  1296. ;    S8 passes the name to use - returned fully qualified
  1297. ; -----------------------------------------------------------------------
  1298. ;
  1299. FileTest:
  1300.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1301.     IF FAILED            ; IF error opening
  1302.        SET SUCCESS OFF        ; Indicate file dne
  1303.        RETURN            ; Rtn to caller
  1304.        ENDIF
  1305.     LJ S9                ; Left justify
  1306. ;
  1307. ;    Read records from BBS-File
  1308. ;
  1309. FTestLoop:
  1310.     READ S0 80 N19            ; Read a record
  1311.     IF EOF GOTO FTestEnd        ; On end of file, report not found
  1312. ;
  1313. ;    With the exception of comments, test for file availability
  1314. ;
  1315.     IF FIND S0(0:0) "*" GOTO FTestLoop  ; Ignore comments simply
  1316.     IF NOT FIND S0(0:11) S9 GOTO FTestLoop
  1317.     S2 = S0(0:11)            ; Extract File name
  1318.     IF FIND S0(28:28) "^A"          ; Look for ^A in description
  1319.        IF FIND S0(29:79) "^A" N11   ; .. want a pair...
  1320.           S2 = S0(29:29+N11-1)&"\"*S2   ; Use between as subdir
  1321.           ENDIF
  1322.        ENDIF
  1323.     IF NOT ISFILE S2 GOTO FTestLoop ; If file dosn't exist
  1324. ;
  1325. ;    We have a match...
  1326. ;
  1327.     S9 = S2             ; Rtn file name in S9
  1328.     FCLOSEI             ; Close input file
  1329.     SET SUCCESS ON            ; And indicate success
  1330.     RETURN                ; Rtn to caller
  1331. ;
  1332. ;    End of loop
  1333. ;
  1334. FTestEnd:
  1335.     FCLOSEI             ; CLOSE the keys file
  1336.     SET SUCCESS OFF         ; Indicate not found
  1337.     RETURN                ; Rtn to caller
  1338. ; -----------------------------------------------------------------------
  1339. ;    List command - list file directories
  1340. ; -----------------------------------------------------------------------
  1341. ;
  1342. Filelist:
  1343.     N10 = 0             ; Initialize counter (# records)
  1344.  
  1345.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1346.     IF FAILED            ; IF error opening
  1347.        TRAN "^M^JNo files are available at this time^M^J"
  1348.        GOTO File_Prompt        ; And go back to files mainline
  1349.        ENDIF
  1350. ;
  1351. ;    Read records from BBS-File
  1352. ;
  1353. FListLoop:
  1354.     READ S9 80 N19            ; Read a record
  1355.     IF EOF GOTO FListEnd        ; On end of file, report count found
  1356. ;
  1357. ;    With the exception of comments, test for file availability
  1358. ;
  1359.     IF FIND S9(0:0) "*" GOTO FListPrint ; Print comments simply
  1360.     S0 = S9(0:11)                ; Extract File name
  1361.     IF FIND S9(28:28) "^A"              ; Look for ^A in description
  1362.        IF FIND S9(29:79) "^A" N11       ; .. want a pair...
  1363.           S0 = S9(29:29+N11-1)&"\"*S0   ; Use between as subdir
  1364.           S9(28:79) = S9(29+N11+1:79)   ; Remove from description
  1365.           ENDIF
  1366.        ENDIF
  1367.     IF NOT ISFILE S0 GOTO FListLoop     ; If file dosn't exist
  1368.     IF FIND S9(12:12) "*"               ; If not dated...
  1369.        FDATE S2 S0 1            ; .. get date
  1370.        FSIZE S3 S0                ; .. and size
  1371.        S9(12:19) = S2            ; .. and put into record
  1372.        S9(21:27) = S3            ; For display
  1373.        ENDIF
  1374. ;
  1375. ;    If nothing has been displayed yet, do a heading
  1376. ;
  1377.     IF ZERO N10            ; If no recs displayed yet
  1378.        TRAN "^M^JName         Dated    Size    Description ^M^J"
  1379.        TRAN "------------ -------- ------- ----------------------------------------------^M^J"
  1380.        ENDIF
  1381. ;
  1382. ;    Format the record for printing
  1383. ;
  1384.     S9 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
  1385. ;
  1386. ;    And display the record
  1387. ;
  1388. FListPrint:
  1389.     PRESERVE S9            ; Retain !s ^s and `s
  1390.     TRAN S9             ; Display the record
  1391.     TRAN "^M^J"                     ; And a cr/lf
  1392.     N10 = N10+1            ; COunt this one
  1393.     GOTO FListLoop            ; Loop until EOF
  1394. ;
  1395. ;    End of loop
  1396. ;
  1397. FListEnd:
  1398.     FCLOSEI             ; CLOSE the keys file
  1399.     GOTO File_Prompt        ; And loop until EOF
  1400. ; -----------------------------------------------------------------------
  1401. ;    Search command - search file directory
  1402. ; -----------------------------------------------------------------------
  1403. ;
  1404. Search:
  1405.     TRAN "^M^JEnter the search string: "
  1406.     GOSUB Read_Comm         ; Read response
  1407.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1408.  
  1409.     IF NULL S9 GOTO File_Prompt    ; If blank response exit
  1410.     S18 = S9            ; Save search string
  1411. ;
  1412. ;    Open the directory for searching
  1413. ;
  1414.     FOPENI "BBS-File"  TEXT         ; Open the mailkey file
  1415.     IF FAILED            ; IF error opening
  1416.        TRAN "^M^JNo files are available at this time^M^J"
  1417.        GOTO File_Prompt        ; And go back to mainline
  1418.        ENDIF
  1419.     N10 = 0             ; Initialize counter (# records)
  1420. ;
  1421. ;    Read a record
  1422. ;
  1423. Search_Loop:
  1424.     READ S9 80 N19            ; Read a record
  1425.     IF EOF GOTO Search_End        ; On end of file, Skip
  1426. ;
  1427. ;    With the exception of comments, test for file availability
  1428. ;
  1429.     IF FIND S9(0:0) "*" GOTO Search_Loop ; Always skip comments
  1430.     S0 = S9(0:11)            ; Extract File name
  1431.     IF FIND S9(28:28) "^A"              ; Look for ^A in description
  1432.        IF FIND S9(29:79) "^A" N11       ; .. want a pair...
  1433.           S0 = S9(29:29+N11-1)&"\"*S0   ; Use between as subdir
  1434.           S9(28:79) = S9(29+N11+1:79)   ; Remove from description
  1435.           ENDIF
  1436.        ENDIF
  1437.     IF NOT ISFILE S0 GOTO Search_Loop   ; If file dosn't exist
  1438.     IF FIND S9(12:12) "*"               ; If not dated...
  1439.        FDATE S2 S0 1            ; .. get date
  1440.        FSIZE S3 S0                ; .. and size
  1441.        S9(12:19) = S2            ; .. and put into record
  1442.        S9(21:27) = S3            ; For display
  1443.        ENDIF
  1444. ;
  1445. ;    Test for target string in record
  1446. ;
  1447.     IF NOT FIND S9 S18 GOTO Search_Loop
  1448. ;
  1449. ;    If nothing has been displayed yet, do a heading
  1450. ;
  1451.     IF ZERO N10            ; If no recs displayed yet
  1452.        TRAN "^M^JName         Dated    Size    Description ^M^J"
  1453.        TRAN "------------ -------- ------- ----------------------------------------------^M^J"
  1454.        ENDIF
  1455. ;
  1456. ;    Format the record for printing
  1457. ;
  1458.     S0 = S9(0:11) * " " * S9(12:19) * " " * S9(21:27) * " " * S9(28:79)
  1459.     PRESERVE S0            ; Retain !s ^s and `s
  1460.     TRAN S0             ; Display the record
  1461.     TRAN "^M^J"                     ; And a cr/lf
  1462.     N10 = N10+1            ; COunt this one
  1463.     GOTO Search_Loop        ; Loop until EOF
  1464. ;
  1465. ;    End of loop
  1466. ;
  1467. Search_End:
  1468.     IF ZERO N10            ; If nothing found...
  1469.        TRAN "^M^JNo matches"        ; Indicate it
  1470.        ENDIF
  1471.  
  1472.     FCLOSEI             ; CLOSE the keys file
  1473.     GOTO File_Prompt        ; And loop until EOF
  1474. ; -----------------------------------------------------------------------
  1475. ;    Leave a comment (branched to - "Main_Prompt")
  1476. ;
  1477. ;    This routine executes out of the defined BBS subdir, no matter
  1478. ;    what subdir a privileged user has selected.  It saves the current
  1479. ;    subdir and restores it upon completion.
  1480. ;
  1481. ;    Note: S19 must be retained throughout this submenu...
  1482. ;          It is used to save the current subdir
  1483. ; -----------------------------------------------------------------------
  1484. ;
  1485. Comment:
  1486.     SUBDIR S19            ; Save current subdir
  1487.     CHDIR S22            ; Reset current subdir
  1488.  
  1489.     MESS "^M^JComment requested "
  1490.     S9 = "Do you wish to leave a comment? (Y/N, cr=n): "
  1491.     S8 = "BBS-NoMe"                 ; Set file name
  1492.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1493.  
  1494.     GOSUB Read_Comm         ; Read a response
  1495.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1496.  
  1497.     FIND S9 "Y"                     ; Look for "Y"
  1498.     IF NOT FOUND            ; IF answer wan't 'Y'
  1499.        TRAN "OK"                    ; Odd character
  1500.        CHDIR S19            ; Reset default subdir
  1501.        GOTO Main_Prompt        ; We're done.
  1502.        ENDIF
  1503. ;
  1504. ;    Open the comments file
  1505. ;
  1506.     FOPENO "BBS-Note" TEXT APPEND ; OPEN file for input
  1507.     IF FAILED            ; if open failed
  1508.        TRAN "Error recording note - please try later^M^J"
  1509.        CHDIR S19            ; Reset default subdir
  1510.        GOTO Main_Prompt        ; GOTO Main_Prompt to caller
  1511.        ENDIF
  1512.  
  1513.     S9 = "*** Note left by "
  1514.     CONCAT S9(17) S1        ; Add User ID
  1515.     DATE S8
  1516.     CONCAT S9(25) S8(0:9)        ; Add date
  1517.     TIME S8 1            ; (military fmt)
  1518.     CONCAT S9(35) S8(0:7)        ; Add time
  1519.     WRITE S9            ; Write header to file     * COM-AND
  1520.     WRITE "!"                       ; Write a record delim   * COM-AND
  1521. ;
  1522. ;    Ask for lines, and write them to the output file
  1523. ;
  1524.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  1525.     TRAN "Enter a line/line(s) of text.  A blank line ends the note.^M^J"
  1526.     GOSUB Copy_Text         ; Note FLAG(0) test below
  1527. ;
  1528. ;    We have a blank line - and the end of a note
  1529. ;
  1530.     WRITE "------------!"           ; Write a delimiter
  1531.     FCLOSEO             ; CLose the file
  1532.     IF FLAG(0) GOTO Exit        ; If COPY_Text rtns flag set, disconn
  1533.     TRAN "Your note has been recorded - thanks^M^J"
  1534. ;
  1535. ;    Log the fact, cleanup and we're done
  1536. ;
  1537.     S9 = "Comment recorded"
  1538.     GOSUB Log_Item            ; Write to BBS-Log
  1539.  
  1540.     CHDIR S19            ; Reset default subdir
  1541.     GOTO Main_Prompt        ; GO for next cmd
  1542. ; -----------------------------------------------------------------------
  1543. ;    Bulletin command: List, and read a specific item
  1544. ;
  1545. ;    The BBS-BULL file is structured:
  1546. ;    0      5        13 14     26
  1547. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1548. ;    ! Number  ! Date    !  ! Fname     ! Subject (40 char)!
  1549. ;    +---/ /---+---/ /---+--+---/ /---+-------/ /--------+
  1550. ;                 ^ Privileged user bulletin flag
  1551. ;
  1552. ;    Note: S19 must be retained throughout this submenu...
  1553. ;          It is used to save the current subdir
  1554. ; -----------------------------------------------------------------------
  1555. ;
  1556. Bull_Command:
  1557.     SUBDIR S19            ; Save current subdir
  1558.     CHDIR S25            ; Switch to Bulletins subdir
  1559. ;
  1560. ;    Restart (perform a list command) at this point
  1561. ;
  1562. BULL_List:
  1563.     MESS "^M^JBulletin list: "      ; Local console indicator
  1564.     N10 = 0             ; Initialize a counter
  1565.  
  1566.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1567.     IF FAILED            ; IF error opening
  1568.        TRAN "^M^JNo bulletins exist^M^J"
  1569.        CHDIR S19            ; Return to default subdir
  1570.        GOTO Main_Prompt        ; And go back to mainline
  1571.        ENDIF
  1572. ;
  1573. ;    Read a record
  1574. ;
  1575. Bull_Loop:
  1576.     READ S9 80 N19            ; Read a record
  1577.     IF EOF GOTO Bull_Prompt     ; Test for end of file
  1578.     IF NOT NULL S9(13:13)        ; Test privilege flag
  1579.        IF NOT FLAG(1) GOTO Bull_Loop; Only display if privileged user
  1580.        ENDIF
  1581. ;
  1582. ;    With the exception of comments, test for file availability
  1583. ;
  1584.     IF FIND S9(0:0) "*" GOTO Bull_Loop ; Skip comments
  1585.  
  1586.     S0 = S9(14:25)            ; Extract File name
  1587.     IF NOT ISFILE S0 GOTO Bull_Loop ; If file dosn't exist
  1588. ;
  1589. ;    If nothing has been displayed yet, do a heading
  1590. ;
  1591.     IF ZERO N10            ; If no recs displayed yet
  1592.        TRAN "^M^JNum   Dated    Subject^M^J"
  1593.        TRAN "----- -------- -------------------------------------------------------------^M^J"
  1594.        ENDIF
  1595. ;
  1596. ;    And display the record
  1597. ;
  1598.     S0 = S9(0:4)*" "*S9(5:12)*" "*S9(26:79)
  1599.     PRESERVE S0            ; Retain !s ^s and `s
  1600.     TRAN S0             ; Display the record
  1601.     TRAN "^M^J"                     ; And a cr/lf
  1602.     N10 = N10+1            ; COunt this one
  1603.     GOTO Bull_Loop            ; Loop until EOF
  1604. ;
  1605. ;    End of loop:  prompt for a bulletin number
  1606. ;
  1607. Bull_Prompt:
  1608.     FCLOSEI             ; CLose the input file
  1609.     GOSUB Display_Limit        ; Report amount of time remaining
  1610.     S9 = "^M^JL)ist, M)ain, E)xit, or a bulletin number: "
  1611.     S8 = "BBS-BuMe"                 ; Set file name
  1612.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1613. ;
  1614. ;    Read a response
  1615. ;
  1616.     GOSUB Read_Comm         ; Read into S9
  1617.     IF FLAG(0) GOTO Exit        ; If first flag rtns set disconn and restart
  1618. ;
  1619. ;    Test for alpha commands
  1620. ;
  1621.     LJ S9                ; Left justify S9
  1622.     IF FIND S9(0:0) "L"             ; If command was List
  1623.        GOTO Bull_List        ; Perform the list again
  1624.        ENDIF
  1625.  
  1626.     IF FIND S9(0:0) "M"             ; If command was Main
  1627.        CHDIR S19            ; Return to default subdir
  1628.        GOTO Main_Prompt        ; Go back to main
  1629.        ENDIF
  1630.  
  1631.     IF FIND S9(0:0) "E"             ; If command was Exit
  1632.        GOTO Logoff            ; Transmit acknowlegement and Exit
  1633.        ENDIF
  1634. ;
  1635. ;    We're going to scan the keys file for the input
  1636. ;
  1637.     FOPENI "BBS-Bull"  TEXT         ; Open the bulletin file
  1638.     IF FAILED            ; IF error opening
  1639.        TRAN "^M^JNo bulletins available^M^J"
  1640.        CHDIR S19            ; Return to default subdir
  1641.        GOTO Main_Prompt        ; And go back to mainline
  1642.        ENDIF
  1643.     S0 = S9             ; Save response in S0
  1644. ;
  1645. ;    Read a record from BBS-Bull
  1646. ;
  1647. Bull_Scan:
  1648.     READ S9 80 N19            ; Read a record
  1649.     IF EOF                ; Test for end of file
  1650.        TRAN "^M^JNo such bulletin!! ^M^J"
  1651.        FCLOSEI            ; CLose input file
  1652.        GOTO Bull_Prompt        ; Select one specific
  1653.        ENDIF
  1654.  
  1655.     IF FIND S9(0:0) "*" GOTO Bull_Scan; Throw away comments
  1656.  
  1657.     IF NOT NULL S9(13:13)        ; Test privilege flag
  1658.        IF NOT FLAG(1) GOTO Bull_Scan; Only display if privileged user
  1659.        ENDIF
  1660. ;
  1661. ;    Test for file availability
  1662. ;
  1663.     S8 = S9(14:25)            ; Extract File name
  1664.     IF NOT ISFILE S8 GOTO Bull_Scan ; If file dosn't exist
  1665. ;
  1666. ;    Test the record number field against the given
  1667. ;
  1668.     S9 = S9(0:4)            ; Extract just the number
  1669.     LJ S9                ; Justify the field in S9; S0 already so
  1670.     SWITCH S9            ; Test using the given #
  1671.        CASE S0(0:4)         ; .. against the rec number field
  1672.           GOTO Bull_Read        ; Match - go read it
  1673.        ENDCASE
  1674.     ENDSWITCH
  1675.     GOTO Bull_Scan            ; Loop until EOF
  1676. ;
  1677. ;    Read a single bulletin - the name is in S8
  1678. ;
  1679. Bull_Read:
  1680.     FCLOSEI             ; Close the mail keys file
  1681.     MESS "^M^JReading bulletin: "*S8; Local console indicator
  1682.  
  1683.     S9 = "^M^JError opening bulletin file" ; Error msg just in case
  1684.     GOSUB Disp_File         ; Display the file
  1685. ;
  1686. ;    Log the fact
  1687. ;
  1688.     S9 = "Bulletin "*S8&" read"
  1689.     GOSUB Log_Item            ; Write to BBS-Log
  1690.     GOTO Bull_Prompt        ; And loop until EOF
  1691. ; -----------------------------------------------------------------------
  1692. ;    Mail command: Read, write or back to main
  1693. ;
  1694. ;    Note: S19 must be retained throughout this submenu...
  1695. ;          It is used to save the current subdir
  1696. ; -----------------------------------------------------------------------
  1697. ;
  1698. Mail_Command:
  1699.     MESS "^M^JMail prompt: "        ; Local console indicator
  1700.     SUBDIR S19            ; Save current default
  1701.     CHDIR S24            ; Set to Messages subdir
  1702. ;
  1703. ;    Prompt for a submenu command
  1704. ;
  1705. Mail_Prompt:
  1706.     GOSUB Display_Limit        ; Report amount of time remaining
  1707.     S9 = "^M^JS)can, L)ist, N)ew, A)ll, W)rite, M)ain or E)xit: "
  1708.     S8 = "BBS-MeMe"                 ; Set file name
  1709.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  1710. ;
  1711. ;    Keep just the first char entered
  1712. ;
  1713.     GOSUB Read_Comm         ; Read into S9
  1714.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  1715.  
  1716.     LJ S9                ; Left justify S9
  1717.     S9 = S9(0:0)            ; Keep just the first char
  1718. ;
  1719. ;    Interpret the command
  1720. ;
  1721.     SWITCH S9            ; Test the entry
  1722.     ;
  1723.     ;    Read-new command
  1724.     ;
  1725.        CASE "N"                     ; New-Read
  1726.           GOTO Read_New
  1727.        ENDCASE
  1728.     ;
  1729.     ;    Read command
  1730.     ;
  1731.        CASE "A"                     ; All-Read
  1732.           GOTO Read_All
  1733.        ENDCASE
  1734.     ;
  1735.     ;    Write command
  1736.     ;
  1737.        CASE "W"                     ; Write
  1738.           GOTO Write_msg
  1739.        ENDCASE
  1740.     ;
  1741.     ;    Scan command
  1742.     ;
  1743.        CASE "S"                     ; Scan
  1744.           GOTO Scan_Msg
  1745.        ENDCASE
  1746.     ;
  1747.     ;    List command
  1748.     ;
  1749.        CASE "L"                     ; Scan
  1750.           GOTO List_Msg
  1751.        ENDCASE
  1752.     ;
  1753.     ;    Main command
  1754.     ;
  1755.        CASE "M"                     ; Go back to main prompt
  1756.           CHDIR S19         ; Reset subdir
  1757.           GOTO Main_Prompt
  1758.        ENDCASE
  1759.     ;
  1760.     ;    Exit command
  1761.     ;
  1762.        CASE "E"                     ; Exit
  1763.           GOTO Logoff        ; Transmit acknowlegement and Exit
  1764.        ENDCASE
  1765.     ENDSWITCH
  1766.  
  1767.     TRAN "Invalid selection - try again^M^J"
  1768.     GOTO Mail_Prompt
  1769. ; -----------------------------------------------------------------------
  1770. ;    Scan command: Scan for files 'to' the current user
  1771. ;
  1772. ;    The MAILKEY file is structured:
  1773. ;    0      8        16 17     25       38
  1774. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1775. ;    ! To ID   ! From ID !  ! Date     ! Fname   ! Subject (40 char)!
  1776. ;    +---/ /---+---/ /---+--+---/ /---+---/ /---+-------/ /--------+
  1777. ;                 ^Privacy flag = P
  1778. ; -----------------------------------------------------------------------
  1779. ;
  1780. Scan_Msg:
  1781.     N10 = 0             ; Initialize counter (# records)
  1782.     N11 = 0             ; Initialize counter (# to current ID)
  1783.  
  1784.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1785.     IF FAILED GOTO Scan_Rpt     ; IF error opening, Use zero cnt
  1786.     TRAN "^M^JWorking..."           ; May take a moment
  1787. ;
  1788. ;    Read records from BBS_Mail
  1789. ;
  1790. Scan_Loop:
  1791.     READ S9 80 N19            ; Read a record
  1792.     IF EOF GOTO Scan_Rpt        ; On end of file, report count found
  1793.  
  1794.     S0 = S9(0:7)            ; Look at 'to ID' field
  1795.     SWITCH S0            ; Test for our ID
  1796.        CASE S1            ; .. in the record
  1797.           S0 = S9(25:37)        ; Extract File name
  1798.           IF ISFILE S0 INC N11      ; If file exists, count it
  1799.        ENDCASE
  1800.     ENDSWITCH
  1801.  
  1802.     INC N10             ; Count the read
  1803.     N12 = N10/10*10         ; Every 10th record
  1804.     IF EQ N10 N12            ; .. or so
  1805.        TRAN "."                     ; .. indicate we didn't die
  1806.        ENDIF
  1807.     GOTO Scan_Loop            ; Loop until EOF
  1808. ;
  1809. ;    Report the count found
  1810. ;
  1811. Scan_Rpt:
  1812.     IF ZERO N11            ; If no files found
  1813.        TRAN "^M^JYou have no messages waiting"
  1814.     ELSE
  1815.        STRFMT S0 "^M^JYou have %d message(s) waiting." N11
  1816.        TRAN S0            ; Transmit the text
  1817.        ENDIF
  1818.  
  1819.     FCLOSEI             ; CLOSE the keys file
  1820.     GOTO Mail_Prompt        ; And loop until EOF
  1821. ; -----------------------------------------------------------------------
  1822. ;    Mail List command: List files available to be read.
  1823. ; -----------------------------------------------------------------------
  1824. ;
  1825. List_Msg:
  1826.     N10 = 0             ; Initialize counter (# records)
  1827.  
  1828.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1829.     IF FAILED            ; IF error opening
  1830.        TRAN "^M^JNo mail exists - why not write something?^M^J"
  1831.        GOTO Mail_Prompt        ; And go back to mainline
  1832.        ENDIF
  1833. ;
  1834. ;    Read a record from BBS-Mail
  1835. ;
  1836. List_Loop:
  1837.     READ S9 80 N19            ; Read a record
  1838.     IF EOF GOTO List_End        ; On end of file, report count found
  1839.  
  1840.     S0 = S9(0:7)            ; Look at 'to ID' field
  1841.     SWITCH S0            ; Test for our ID
  1842.        CASE S1            ; .. in the record
  1843.        ENDCASE            ; OK if addressed to us
  1844.        DEFAULT            ; If not our ID, test privacy
  1845.          IF FIND S9(16:16) "P"      ; Test privacy flag
  1846.         IF NOT STRCMP S9(8:15) S1 ; If we didn't write it
  1847.            GOTO List_Loop    ; Ignore private messages
  1848.            ENDIF
  1849.         ENDIF
  1850.        ENDCASE
  1851.     ENDSWITCH
  1852.  
  1853.     S0 = S9(25:37)            ; Extract File name
  1854.     IF NOT ISFILE S0 GOTO List_Loop ; If file dosn't exist
  1855. ;
  1856. ;    If nothing has been displayed yet, do a heading
  1857. ;
  1858.     IF ZERO N10            ; If no recs displayed yet
  1859.        TRAN "^M^JTo       From     Date     Subject^M^J"
  1860.        TRAN "-------- -------- -------- -------------------------------------------------^M^J"
  1861.        ENDIF
  1862. ;
  1863. ;    And display the record
  1864. ;
  1865.     S0 = S9(0:7)*" "*S9(8:15)*" "*S9(17:24)*" "*S9(38:79)
  1866.     PRESERVE S0            ; Retain !s ^s and `s
  1867.     TRAN S0             ; Display the record
  1868.     TRAN "^M^J"                     ; And a cr/lf
  1869.     N10 = N10+1            ; COunt this one
  1870.     GOTO List_Loop            ; Loop until EOF
  1871. ;
  1872. ;    End of loop
  1873. ;
  1874. List_End:
  1875.     FCLOSEI             ; CLOSE the keys file
  1876.     GOTO Mail_Prompt        ; And loop until EOF
  1877. ; -----------------------------------------------------------------------
  1878. ;    Read NEW command: Read NEW mail files 'to' the current user
  1879. ;    Setup S7 limiting date
  1880. ; -----------------------------------------------------------------------
  1881. ;
  1882. Read_New:
  1883.     S7 = "        "                 ; Make earliest possible date
  1884.     IF NOT ISFILE S1&".NEW" GOTO Read_Msg
  1885.     FOPENI S1&".NEW" TEXT           ; Open ID.NEW file
  1886.     IF FAILED GOTO Read_Msg     ; Skip on error
  1887.     READ S7 8 N19            ; Read oldest date read
  1888.     FCLOSEI             ; Close file
  1889.     GOTO Read_Msg            ; And read using this date
  1890. ; -----------------------------------------------------------------------
  1891. ;    Read ALL command: Read ALL mail files 'to' the current user
  1892. ;    Setup S7 limiting date
  1893. ; -----------------------------------------------------------------------
  1894. ;
  1895. Read_All:
  1896.     S7 = "        "                 ; Make earliest possible date
  1897.     GOTO Read_Msg            ; And read using this date
  1898. ; -----------------------------------------------------------------------
  1899. ;    Test two dates, one in S0 and one in S2  (each fmttd mm/dd/yy)
  1900. ;    N10 returns -1 if S0 date < S2 date
  1901. ;             0 if S0 date = S2 date
  1902. ;            +1 if S0 date > S2 date
  1903. ; -----------------------------------------------------------------------
  1904. ;
  1905. DateTest:
  1906.     IF NOT NUMERIC S2(0) or NOT NUMERIC S2(3) or NOT NUMERIC S2(6)
  1907.        N10 = 0            ; Fake they're equal
  1908.        RETURN            ; .. and done
  1909.        ENDIF
  1910.  
  1911.     IF NOT NUMERIC S0(0) or NOT NUMERIC S0(3) or NOT NUMERIC S0(6)
  1912.        N10 = 0            ; Fake they're equal
  1913.        RETURN            ; .. and done
  1914.        ENDIF
  1915.  
  1916.     IF S0(6:7) EQ S2(6:7)        ; If recordyear = limityear
  1917.        N10 = (S0(0:1)*100+S0(3:4)) - (S2(0:1)*100+S2(3:4))
  1918.        IF N10 LT 0            ; S0 < S2
  1919.           N10 = -1            ; Return S0 < S2
  1920.        ELSE
  1921.           IF N10 GT 0        ; S0 > S2
  1922.          N10 = 1        ; Return S0 > S2
  1923.           ELSE
  1924.          N10 = 0        ; Return S0 = S2
  1925.          ENDIF
  1926.           ENDIF
  1927.        RETURN            ; And we're done here
  1928.        ENDIF
  1929.  
  1930.     N10 = S0(6:7)+1900        ; Extract S0 year, dft 1900 century
  1931.     N11 = S2(6:7)+1900        ; Extract S2 year, dft 1900 century
  1932.     IF S0(6:7) LT 80 N10 = N10+100    ; 00-79 -> 2000 century
  1933.     IF S2(6:7) LT 80 N11 = N10+100    ; 00-79 -> 2000 century
  1934.  
  1935.     IF N10 LT N11            ; S0 < S2
  1936.        N10 = -1            ; Return S0 < S2
  1937.     ELSE
  1938.        IF N10 GT N11        ; S0 > S2
  1939.           N10 = 1            ; Return S0 > S2
  1940.        ELSE
  1941.           N10 = 0            ; Return S0 = S2
  1942.           ENDIF
  1943.        ENDIF
  1944.     RETURN
  1945. ; -----------------------------------------------------------------------
  1946. ;    Read command: Read mail files 'to' the current user
  1947. ;    S7 passes the date on/after which to read (formatted yymmdd)
  1948. ;    S2 will be used to keep the date of the last record read
  1949. ;    S3 will be used to keep latest date read
  1950. ;    S4 will be used to keep the sender ID
  1951. ;    S5 will be used to keep the subject text
  1952. ; -----------------------------------------------------------------------
  1953. ;
  1954. Read_Msg:
  1955.     FOPENI "BBS-Mail"  TEXT         ; Open the mailkey file
  1956.     IF FAILED            ; IF error opening
  1957.        TRAN "^M^JNo mail exists - why not write something?^M^J"
  1958.        GOTO Mail_Prompt        ; And continue
  1959.        ENDIF
  1960.     S3 = "        "                 ; Date of oldest note read
  1961. ;
  1962. ;    Read a line from BBS-Mail
  1963. ;
  1964. Read_Loop:
  1965.     READ S9 80 N19            ; Read a record
  1966.     IF EOF GOTO Read_End        ; On end of file, exit
  1967. ;
  1968. ;    Test the date of the item against the passed limiting date
  1969. ;    .. if either contain non-alpha, skip this step
  1970. ;
  1971.     S2 = S9(17:24)            ; Extract date from record
  1972.     S0 = S7             ; Setup limiting date for compare
  1973.     GOSUB DateTest            ; Compare date in S0 to date in S7
  1974.     IF N10 GT 0 GOTO Read_Loop    ; Skip if limitdate > recorddate
  1975. ;
  1976. ;    Test the ID from the record
  1977. ;
  1978.     S0 = S9(0:7)            ; Look at 'to ID' field
  1979.     SWITCH S0            ; Test ID from the record
  1980.     ;
  1981.     ;    Test for mail to current caller
  1982.     ;
  1983.        CASE S1            ; Against our own ID
  1984.           SET FLAG(9) ON        ; Flag for delete
  1985.        ENDCASE
  1986.     ;
  1987.     ;    Not to current caller - test sender/privacy
  1988.     ;
  1989.        DEFAULT            ; If not our ID, test privacy
  1990.           SET FLAG(9) OFF        ; Flag no delete
  1991.           IF STRCMP S9(8:15) S1 SET FLAG(9) ON ; If we wrote it
  1992.           IF FIND S9(16:16) "P" and NOT FLAG(9)
  1993.          GOTO Read_Loop     ; So.. ignore private messages
  1994.          ENDIF
  1995.        ENDCASE
  1996.     ENDSWITCH
  1997. ;
  1998. ;    We'll read the message
  1999. ;
  2000.     S0 = S9(25:37)            ; Extract File name
  2001.     IF NOT ISFILE S0 GOTO Read_Loop ; If file dosn't exist
  2002. ;
  2003. ;    Save a few values for reply...
  2004. ;
  2005.     S4 = S9(8:15)            ; Setup from-ID for later
  2006.     S5 = S9(38:79)            ; Save subject for later too
  2007. ;
  2008. ;    Display the current file
  2009. ;
  2010.     S8 = S0             ; Set-up file name
  2011.     S9 = "^M^JError opening mailfile"
  2012.     GOSUB Disp_File         ; Display the file
  2013. ;
  2014. ;    Save the date of the record read (S2 contains record date)
  2015. ;
  2016.     S0 = S3             ; Setup oldest date read
  2017.     GOSUB DateTest            ; Compare the two dates
  2018.     IF NULL S3 or N10 LT 0 S3 = S2    ; If oldestdate < recorddate, save new oldest
  2019. ;
  2020. ;    Prompt for next action
  2021. ;
  2022. Read_Disposition:
  2023.     IF FLAG(9)            ; If delete is possible
  2024.        TRAN "^M^JD)elete, R)eply, Q)uit (cr=continue): "
  2025.     ELSE                ; Delete not possible
  2026.        TRAN "^M^JR)eply, Q)uit (cr=continue): "
  2027.        ENDIF
  2028.     GOSUB Read_Comm         ; Read into S9
  2029.     IF FLAG(0) GOTO Exit        ; If first flag rtns set, disconn
  2030.  
  2031.     LJ S9                ; Left justify S9
  2032.     S9 = S9(0:0)            ; Keep just the first char
  2033.     IF NULL S9 S9 = "c"             ; Fake 'continue'
  2034. ;
  2035. ;    Interpret the command
  2036. ;
  2037.     SWITCH S9            ; Test the entry
  2038.     ;
  2039.     ;    Delete command
  2040.     ;
  2041.        CASE "D"                     ; Delete
  2042.         IF FLAG(9)        ; If it was ours
  2043.            DELETE S8        ; Delete file named in S8
  2044.            TRAN "Message deleted^M^J"; Indicate its done
  2045.         ELSE
  2046.            TRAN "You may not delete this note^M^J"
  2047.            ENDIF
  2048.        ENDCASE
  2049.     ;
  2050.     ;    Reply command
  2051.     ;
  2052.        CASE "R"                     ; All-Read
  2053.           S10 = S4            ; Reply To-ID is current note from-id
  2054.           S11 = S5            ; Default reply subj text
  2055.           IF NOT STRCMP S5(0:9) "Reply to: " S11 = "Reply to: "*S5
  2056.           GOSUB Reply        ; COmpose the reply
  2057.           IF FLAG(0) GOTO Exit    ; Exit on disconn
  2058.        ENDCASE
  2059.     ;
  2060.     ;    Continue command
  2061.     ;
  2062.        CASE "C"                     ; Continue
  2063.           GOTO Read_Loop
  2064.        ENDCASE
  2065.     ;
  2066.     ;    Quit command
  2067.     ;
  2068.        CASE "Q"                     ; Quit
  2069.           GOTO Read_End
  2070.        ENDCASE
  2071.     ;
  2072.     ;    Unrecognized command
  2073.     ;
  2074.        DEFAULT            ; Anything else
  2075.           TRAN "^M^JUnrecognized command - please try again^M^J"
  2076.        ENDCASE
  2077.     ENDSWITCH
  2078.     GOTO Read_Disposition
  2079. ;
  2080. ;    End of read... close input file, and we're done
  2081. ;
  2082. Read_End:
  2083.     FCLOSEI             ; Close the mail keys file
  2084.     IF NOT NULL S3            ; If we read something
  2085.        FOPENO S1&".NEW" TEXT        ; Open ID.NEW file
  2086.        IF FAILED GOTO Mail_Prompt    ; Skip on error
  2087.        WRITE S3*"!"                 ; Write saved date
  2088.        FCLOSEO            ; Close file
  2089.        ENDIF
  2090.     GOTO Mail_Prompt        ; And loop until EOF
  2091. ; -----------------------------------------------------------------------
  2092. ;    Write command - write mail
  2093. ; -----------------------------------------------------------------------
  2094. ;
  2095. Write_Msg:
  2096.     GOSUB Compose            ; Invoke compose a note
  2097.     IF FLAG(0) GOTO Exit        ; Exit on disconn
  2098.     GOTO Mail_Prompt        ; GO for next cmd
  2099. ; -----------------------------------------------------------------------
  2100. ;    Write a mail note - this is a subroutine, as it is called by both
  2101. ;    Read-mail (reply) and Write-Mail.  Note:
  2102. ;    S3 and S7 must be preserved for Read_Msg...
  2103. ;    The caller must test FLAG(0) for disconn...
  2104. ;    An existing FOPENI must be preserved
  2105. ; -----------------------------------------------------------------------
  2106. ;    The entry point 'Reply' requires that S10 contain the TO ID and
  2107. ;    S11 contain the subject line
  2108. ; -----------------------------------------------------------------------
  2109. ;
  2110. Compose:
  2111.     TRAN "To:  ^H"                  ; Prompt for ID
  2112.     GOSUB Read_Comm         ; Read a response
  2113.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2114.  
  2115.     LJ S9                ; Left justify ID
  2116.     IF NULL S9 RETURN        ; If blank entry - exit here
  2117.     S10 = S9(0:7)            ; Save TO ID
  2118.     UPPER S10            ; Force it upper case
  2119. ;
  2120. ;    Prompt for a subject
  2121. ;
  2122.     TRAN "Subject:  ^H"             ; Prompt for subject
  2123.     GOSUB Read_Comm         ; Read a response
  2124.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2125.     S11 = S9            ; Save returned subject
  2126.     PRESERVE S11            ; Retain !s ^s and `s
  2127. ;
  2128. ;    Open a temporary file
  2129. ;
  2130. Reply:
  2131.     FOPENO "\HOSTTEMP.TXT" TEXT     ; OPEN file for output
  2132.     IF FAILED            ; if open failed
  2133.        TRAN "Error opening file - please try later^M^J"
  2134.        RETURN            ; Back to submenu
  2135.        ENDIF
  2136. ;
  2137. ;    Place a header
  2138. ;
  2139.     S9 = "To:    "                  ; Set Sender ID
  2140.     CONCAT S9(7) S10        ; ..
  2141.     WRITE S9            ; Write header to file     * COM-AND
  2142.     WRITE "!"                       ; Write a record delim   * COM-AND
  2143.  
  2144.     S9 = "From: "                   ; Set Sender ID
  2145.     CONCAT S9(7) S1         ; ..
  2146.     WRITE S9            ; Write header to file     * COM-AND
  2147.     WRITE "!"                       ; Write a record delim   * COM-AND
  2148.  
  2149.     S9 = "Date: "                   ; Set date and time
  2150.     DATE S12
  2151.     CONCAT S9(7) S12        ; Add date
  2152.     TIME S8 1            ; (military fmt)
  2153.     CONCAT S9(17) S8        ; Add time
  2154.     WRITE S9            ; Write header to file     * COM-AND
  2155.     WRITE "!"                       ; Write a record delim   * COM-AND
  2156.  
  2157.     S9 = "Subject: "                ; Set subject
  2158.     CONCAT S9(9)  S11        ; ..
  2159.     WRITE S9            ; Write header to file     * COM-AND
  2160.     WRITE "!"                       ; Write a record delim   * COM-AND
  2161.     WRITE "!"                       ; Write a text delim     * COM-AND
  2162. ;
  2163. ;    Ask for lines, and write them to the output file
  2164. ;
  2165.     TRAN "Each line, as you enter it will be recorded.  No edits, yet...^M^J"
  2166.     TRAN "Enter a line/line(s) of text.  A blank line ends the text.^M^J"
  2167.     GOSUB Copy_Text         ; Note FLAG(0) test below
  2168.     FCLOSEO             ; Close the file
  2169.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2170. ;
  2171. ;    Ask if the file is to be saved
  2172. ;
  2173.     TRAN "Save? (Y/N, cr=y):  ^H"   ; Ask if its to be saved
  2174.     GOSUB Read_Comm         ; Read a response
  2175.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2176.  
  2177.     IF FIND S9 "N" RETURN           ; Test for "N"
  2178. ;
  2179. ;    Now - scan for the last used file name
  2180. ;
  2181.     TRAN "^M^JScanning for free slot"
  2182.     N10 = 0             ; Set default extension we'll use
  2183.     S0 = S10(0:7)            ; Look at 'to ID' field
  2184. ;
  2185. ;    Look for a free file name
  2186. ;
  2187.     WHILE ISFILE S0&"."&N10         ; Find unused note #
  2188.           INC N10            ; Bump ptr
  2189.           IF N10 GT 999        ; If max msgs reached...
  2190.          TRAN "^M^JToo many notes left undeleted - cannot save^M^J"
  2191.          RETURN         ; Back to caller
  2192.          ENDIF
  2193.           ENDWHILE            ; Loop until match
  2194. ;
  2195. ;    We have found the first free file name
  2196. ;
  2197.     TRAN "^M^JPrivate? (Y/N, cr=n): "; Ask if its to a private msg
  2198.     GOSUB Read_Comm         ; Read a response
  2199.     IF FLAG(0) RETURN        ; If first flag rtns set, disconn
  2200.  
  2201.     S13 = " "                       ; Set privacy flag
  2202.     IF FIND S9 "Y" S13 = "P"        ; Test for "Y" - set flag val
  2203.  
  2204.     S0 = S0&"."&N10                 ; Make a new file name
  2205.     S9 = "COPY \HOSTTEMP.TXT " * S0 ; Make a copy command
  2206.     DOS S9                ; Cannot do own copy (FOPENI in use)
  2207.  
  2208.     FOPENO "BBS-Mail" TEXT APPEND   ; Open the keys file for append
  2209.     WRITE S10 8            ; Write the 'TO ID'
  2210.     WRITE S1  8            ; Write the from ID
  2211.     WRITE S13 1            ; Write privacy flag
  2212.     WRITE S12 8            ; Write date
  2213.     WRITE S0  13            ; Write file name
  2214.     WRITE S11 40            ; Write the subject
  2215.     WRITE "!"                       ; And a delimiter
  2216.     FCLOSEO             ; ANd close the keys file
  2217.     RETURN                ; GO for next cmd
  2218. ; -----------------------------------------------------------------------
  2219. ;    Registration (Exit must be performed after)
  2220. ;
  2221. ;    Upon return: FLAG(0) ON -> Caller disconnected
  2222. ; -----------------------------------------------------------------------
  2223. ;
  2224. Register:
  2225.     MESS "^M^JRegistration requested "
  2226.     S9 = "Do you wish to register? (Y/N, cr=y): "
  2227.     S8 = "BBS-ReMe"                 ; Set file name
  2228.     GOSUB Disp_File         ; Display file contents or S9 if file D.N.E
  2229.  
  2230.     GOSUB Read_Comm         ; Read a response
  2231.     IF FLAG(0)            ; If error
  2232.        S9 = "Registration aborted - disconn"
  2233.        GOSUB Log_Item        ; Log the fact
  2234.        RETURN            ; SImply return
  2235.        ENDIF
  2236.  
  2237.     IF FIND S9 "N"                  ; IF answer wasn't 'n'
  2238.        S9 = "Registration declined by caller"
  2239.        GOSUB Log_Item        ; Log the fact
  2240.        TRAN "OK - bye^M^J"          ; Say g'night Gracie
  2241.        RETURN            ; We're done.
  2242.        ENDIF
  2243. ;
  2244. ;    Ask for a name/address/csz phone and ID/Password
  2245. ;
  2246.     TRAN "Enter your full name: "
  2247.     GOSUB Read_Comm         ; Read a response
  2248.     IF FLAG(0) RETURN        ; If error
  2249.     S18 = S9            ; Save return
  2250.  
  2251.     TRAN "Enter your street address: "
  2252.     GOSUB Read_Comm         ; Read a response
  2253.     IF FLAG(0) RETURN        ; If error
  2254.     S17 = S9            ; Save return
  2255.  
  2256.     TRAN "Enter your city/state and zip: "
  2257.     GOSUB Read_Comm         ; Read a response
  2258.     IF FLAG(0) RETURN        ; If error
  2259.     S16 = S9            ; Save return
  2260.  
  2261.     TRAN "Enter a area code and phone number where^M^J"
  2262.     TRAN "you may be reached:  "
  2263.     GOSUB Read_Comm         ; Read a response
  2264.     IF FLAG(0) RETURN        ; If error
  2265.     S15 = S9            ; Save return
  2266. ;
  2267. ;    Request an ID
  2268. ;
  2269. Reg_ID:
  2270.     TRAN "Enter the ID (1-8 chars) you wish to use: "
  2271.     GOSUB Read_Comm         ; Read a response
  2272.     IF FLAG(0) RETURN        ; If error
  2273.  
  2274.     IF FIND S9(0:7) "."
  2275.        TRAN "ID may not contain '.'s^M^J"
  2276.        GOTO Reg_ID
  2277.        ENDIF
  2278.     IF FIND S9(0:7) ","
  2279.        TRAN "ID may not contain ','s^M^J"
  2280.        GOTO Reg_ID
  2281.        ENDIF
  2282.     IF FIND S9(0:7) "\"
  2283.        TRAN "ID may not contain '\'s^M^J"
  2284.        GOTO Reg_ID
  2285.        ENDIF
  2286.     IF FIND S9(0:7) "/"
  2287.        TRAN "ID may not contain '/'s^M^J"
  2288.        GOTO Reg_ID
  2289.        ENDIF
  2290.     S14 = S9(0:7)            ; Save return
  2291. ;
  2292. ;    Request a password
  2293. ;
  2294. Reg_Pass:
  2295.     TRAN "Enter the password (1-8 chars) you wish to use: "
  2296.     GOSUB Read_Comm         ; Read a response
  2297.     IF FLAG(0) RETURN        ; If error
  2298.  
  2299.     IF NULL S9(0:7)         ; Test for blank entered
  2300.        TRAN "You must have a password^M^J"
  2301.        GOTO Reg_Pass
  2302.        ENDIF
  2303.     S14 = S14 & ";" &S9(0:7)        ; Concatenate PASSWORD to ID
  2304. ;
  2305. ;    Repeat for validity:
  2306. ;
  2307.     TRAN "^M^JRepeating your entry...^M^J"
  2308.     TRAN S18            ; Transmit name
  2309.     TRAN "^M^J"
  2310.     TRAN S17            ; Transmit Street address
  2311.     TRAN "^M^J"
  2312.     TRAN S16            ; Transmit CSZ
  2313.     TRAN "^M^J"
  2314.     TRAN S15            ; Transmit Phone
  2315.     TRAN "^M^J"
  2316.     TRAN S14            ; Transmit ID/password
  2317.  
  2318.     TRAN "^M^JIs this correct? (Y/N, cr=n): "
  2319.     GOSUB Read_Comm         ; Read a response
  2320.     IF FLAG(0) RETURN        ; If error
  2321.  
  2322.     FIND S9 "Y"                     ; Look for "Y"
  2323.     IF NOT FOUND GOTO Register    ; IF answer wan't 'Y', try again
  2324. ;
  2325. ;    Open the comments file
  2326. ;
  2327.     FOPENO "BBS-Note" TEXT APPEND   ; OPEN file for input
  2328.     IF FAILED            ; if open failed
  2329.        TRAN "Error recording registration - please call back^M^J"
  2330.        RETURN            ; Return to caller
  2331.        ENDIF
  2332.  
  2333.     S9 = "*** Registration requested: "
  2334.     DATE S1
  2335.     CONCAT S9(27) S1        ; S1 would be ID anyway
  2336.     TIME S1 1            ; (military fmt)
  2337.     CONCAT S9(38) S1
  2338.     WRITE S9            ; Write a record     * COM-AND
  2339.     WRITE "!"                       ; Write a record delim   * COM-AND
  2340.  
  2341.     WRITE S18 80            ; Write a record     * COM-AND
  2342.     WRITE "!"                       ; Write a record delim   * COM-AND
  2343.     WRITE S17 80            ; Write a record     * COM-AND
  2344.     WRITE "!"                       ; Write a record delim   * COM-AND
  2345.     WRITE S16 80            ; Write a record     * COM-AND
  2346.     WRITE "!"                       ; Write a record delim   * COM-AND
  2347.     WRITE S15 80            ; Write a record     * COM-AND
  2348.     WRITE "!"                       ; Write a record delim   * COM-AND
  2349.     WRITE S14 80            ; Write a record     * COM-AND
  2350.     WRITE "!"                       ; Write a record delim   * COM-AND
  2351.     WRITE "------------!"           ; Write a delimiter
  2352. ;
  2353. ;    Log the fact
  2354. ;
  2355.     S9 = "Registration requested"
  2356.     GOSUB Log_Item            ; Write to BBS-Log
  2357. ;
  2358. ;    We have a successful record
  2359. ;
  2360.     TRAN "Your request will be processed by the SYSOP^M^J"
  2361.     TRAN "Thanks for calling...^M^J"
  2362.  
  2363.     FCLOSEO             ; CLose the file
  2364.     RETURN                ; Return from subroutine
  2365. ; -----------------------------------------------------------------------
  2366. ;    Auto baudrate detect (according to message in S9)
  2367. ;
  2368. ;    This procedure is placed last to ensure that the entire script
  2369. ;    file is scanned once before the main prompt.  COM-AND caches
  2370. ;    label addresses, so this ensures that the 1st 100 labels are
  2371. ;    known by COM-AND (and thus can be quickly reached).
  2372. ; -----------------------------------------------------------------------
  2373. ;
  2374. AutoBaud:
  2375.     IF FIND S9 "1200"
  2376.        SET BAUD 1200        ; Set to new rate
  2377.        GOTO AUBA100         ; Log the fact
  2378.        ENDIF
  2379.  
  2380.     IF FIND S9 "2400"
  2381.        SET BAUD 2400        ; Set to new rate
  2382.        GOTO AUBA100         ; Log the fact
  2383.        ENDIF
  2384.  
  2385.     IF FIND S9 "4800"
  2386.        SET BAUD 4800        ; Set to new rate
  2387.        GOTO AUBA100         ; Log the fact
  2388.        ENDIF
  2389.  
  2390.     IF FIND S9 "9600"
  2391.        SET BAUD 9600        ; Set to new rate
  2392.        GOTO AUBA100         ; Log the fact
  2393.        ENDIF
  2394.  
  2395.     IF FIND S9 "14400" or FIND S9 "14.4"
  2396.        SET BAUD 14k         ; Set to new rate
  2397.        GOTO AUBA100         ; Log the fact
  2398.        ENDIF
  2399.  
  2400.     IF FIND S9 "19200" or FIND S9 "19.2"
  2401.        SET BAUD 19k         ; Set to new rate
  2402.        GOTO AUBA100         ; Log the fact
  2403.        ENDIF
  2404.  
  2405.     IF FIND S9 "38400" or FIND S9 "38.4"
  2406.        SET BAUD 38k         ; Set to new rate
  2407.        GOTO AUBA100         ; Log the fact
  2408.        ENDIF
  2409.  
  2410.     IF FIND S9 "57600" or FIND S9 "57.6"
  2411.        SET BAUD 57k         ; Set to new rate
  2412.        GOTO AUBA100         ; Log the fact
  2413.        ENDIF
  2414. ;
  2415. ;    None of the above... set to 300
  2416. ;
  2417.     SET BAUD 300            ; Set to 1200 baud
  2418. ;
  2419. ;    Log the connect string to the log
  2420. ;
  2421. AUBA100:
  2422.     GOSUB Log_Item            ; Write connect string to log
  2423.     RETURN                ; We're done.
  2424.